diff mbox series

[fortran] PR88980 - [9 regression] segfault on allocatable string member assignment

Message ID CAGkQGiKfK6u-pUkT+a_MYXEFuHQ39Nmya=GEbRjmLYXMdMXoMA@mail.gmail.com
State New
Headers show
Series [fortran] PR88980 - [9 regression] segfault on allocatable string member assignment | expand

Commit Message

Paul Richard Thomas Feb. 1, 2019, 1:10 p.m. UTC 
This patch is rather simpler than it looks.

The segfault was occurring because r264724 changed the array reference
for cases like these to use pointer arithmetic to obtain the element.
Unfortunately, in the case, the span field of the descriptor was not
being set during the allocation of the component items.

The ChangeLog adequately explains the fix and results in the span
field being set unconditionally.

Bootstrapped and regtested on FC28/x86_64 - OK for trunk?

Paul

2019-02-01  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/88980
    * trans-array.c (gfc_array_init_size): Add element_size to the
    arguments.
    (gfc_array_allocate): Remove the recalculation of the size of
    the element and use element_size from the call to the above.
    Unconditionally set the span field of the descriptor.

2019-02-01  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/88980
    * gfortran.dg/realloc_on_assign_32.f90 : New test.

Comments

Steve Kargl Feb. 1, 2019, 3:46 p.m. UTC | #1 
On Fri, Feb 01, 2019 at 01:10:21PM +0000, Paul Richard Thomas wrote:
> This patch is rather simpler than it looks.
> 
> The segfault was occurring because r264724 changed the array reference
> for cases like these to use pointer arithmetic to obtain the element.
> Unfortunately, in the case, the span field of the descriptor was not
> being set during the allocation of the component items.
> 
> The ChangeLog adequately explains the fix and results in the span
> field being set unconditionally.
> 
> Bootstrapped and regtested on FC28/x86_64 - OK for trunk?
> 


OK. Thanks for the patch.
diff mbox series

Patch

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 268231)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_array_init_size (tree descriptor, in
*** 5370,5383 ****
  		     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
  		     stmtblock_t * descriptor_block, tree * overflow,
  		     tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
! 		     tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr)
  {
    tree type;
    tree tmp;
    tree size;
    tree offset;
    tree stride;
-   tree element_size;
    tree or_expr;
    tree thencase;
    tree elsecase;
--- 5370,5383 ----
  		     gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
  		     stmtblock_t * descriptor_block, tree * overflow,
  		     tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
! 		     tree expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
! 		     tree *element_size)
  {
    tree type;
    tree tmp;
    tree size;
    tree offset;
    tree stride;
    tree or_expr;
    tree thencase;
    tree elsecase;
*************** gfc_array_init_size (tree descriptor, in
*** 5628,5637 ****
      tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
  
    /* Convert to size_t.  */
!   element_size = fold_convert (size_type_node, tmp);
  
    if (rank == 0)
!     return element_size;
  
    *nelems = gfc_evaluate_now (stride, pblock);
    stride = fold_convert (size_type_node, stride);
--- 5628,5637 ----
      tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
  
    /* Convert to size_t.  */
!   *element_size = fold_convert (size_type_node, tmp);
  
    if (rank == 0)
!     return *element_size;
  
    *nelems = gfc_evaluate_now (stride, pblock);
    stride = fold_convert (size_type_node, stride);
*************** gfc_array_init_size (tree descriptor, in
*** 5641,5654 ****
       dividing.  */
    tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
  			 size_type_node,
! 			 TYPE_MAX_VALUE (size_type_node), element_size);
    cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
  					logical_type_node, tmp, stride),
  		       PRED_FORTRAN_OVERFLOW);
    tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
  			 integer_one_node, integer_zero_node);
    cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
! 					logical_type_node, element_size,
  					build_int_cst (size_type_node, 0)),
  		       PRED_FORTRAN_SIZE_ZERO);
    tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
--- 5641,5654 ----
       dividing.  */
    tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
  			 size_type_node,
! 			 TYPE_MAX_VALUE (size_type_node), *element_size);
    cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
  					logical_type_node, tmp, stride),
  		       PRED_FORTRAN_OVERFLOW);
    tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
  			 integer_one_node, integer_zero_node);
    cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
! 					logical_type_node, *element_size,
  					build_int_cst (size_type_node, 0)),
  		       PRED_FORTRAN_SIZE_ZERO);
    tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
*************** gfc_array_init_size (tree descriptor, in
*** 5658,5664 ****
    *overflow = gfc_evaluate_now (tmp, pblock);
  
    size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
! 			  stride, element_size);
  
    if (poffset != NULL)
      {
--- 5658,5664 ----
    *overflow = gfc_evaluate_now (tmp, pblock);
  
    size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
! 			  stride, *element_size);
  
    if (poffset != NULL)
      {
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5736,5741 ****
--- 5736,5742 ----
    tree var_overflow = NULL_TREE;
    tree cond;
    tree set_descriptor;
+   tree element_size = NULL_TREE;
    stmtblock_t set_descriptor_block;
    stmtblock_t elseblock;
    gfc_expr **lower;
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5852,5858 ****
  			      &offset, lower, upper,
  			      &se->pre, &set_descriptor_block, &overflow,
  			      expr3_elem_size, nelems, expr3, e3_arr_desc,
! 			      e3_has_nodescriptor, expr);
  
    if (dimension)
      {
--- 5853,5859 ----
  			      &offset, lower, upper,
  			      &se->pre, &set_descriptor_block, &overflow,
  			      expr3_elem_size, nelems, expr3, e3_arr_desc,
! 			      e3_has_nodescriptor, expr, &element_size);
  
    if (dimension)
      {
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5924,5961 ****
  
    gfc_add_expr_to_block (&se->pre, tmp);
  
!   /* Update the array descriptors.  */
    if (dimension)
!     gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
! 
!   /* Set the span field for pointer and deferred length character arrays.  */
!   if ((is_pointer_array (se->expr)
!        || (expr->ts.type == BT_CLASS && CLASS_DATA (expr)->attr.class_pointer)
!        || (expr->ts.type == BT_CHARACTER && TREE_CODE (se->string_length)
! 							== COMPONENT_REF))
!       || (expr->ts.type == BT_CHARACTER
! 	  && (expr->ts.deferred || VAR_P (expr->ts.u.cl->backend_decl))))
!     {
!       if (expr3 && expr3_elem_size != NULL_TREE)
! 	tmp = expr3_elem_size;
!       else if (se->string_length
! 	       && (TREE_CODE (se->string_length) == COMPONENT_REF
! 		   || (expr->ts.type == BT_CHARACTER && expr->ts.deferred)))
! 	{
! 	  if (expr->ts.kind != 1)
! 	    {
! 	      tmp = build_int_cst (gfc_array_index_type, expr->ts.kind);
! 	      tmp = fold_build2_loc (input_location, MULT_EXPR,
! 				    gfc_array_index_type, tmp,
! 				    fold_convert (gfc_array_index_type,
! 						  se->string_length));
! 	    }
! 	  else
! 	    tmp = se->string_length;
! 	}
!       else
! 	tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (se->expr)));
!       tmp = fold_convert (gfc_array_index_type, tmp);
        gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
      }
  
--- 5925,5935 ----
  
    gfc_add_expr_to_block (&se->pre, tmp);
  
!   /* Update the array descriptor with the offset and the span.  */
    if (dimension)
!     {
!       gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
!       tmp = fold_convert (gfc_array_index_type, element_size);
        gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
      }
  
Index: gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90
===================================================================
*** gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90	(working copy)
***************
*** 0 ****
--- 1,31 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR88980 in which the 'span' field if the descriptor
+ ! for 'Items' was not set, causing the assignment to segfault.
+ !
+ ! Contributed by Antony Lewis  <antony@cosmologist.info>
+ !
+ program tester
+   call gbug
+ contains
+   subroutine gbug
+     type TNameValue
+       character(LEN=:), allocatable :: Name
+     end type TNameValue
+ 
+     type TNameValue_pointer
+       Type(TNameValue), allocatable :: P
+     end type TNameValue_pointer
+ 
+     Type TType
+       type(TNameValue_pointer), dimension(:), allocatable :: Items
+     end type TType
+     Type(TType) T
+ 
+     allocate(T%Items(2))
+     allocate(T%Items(2)%P)
+     T%Items(2)%P%Name =  'test'
+     if (T%Items(2)%P%Name .ne.  'test') stop 1
+ 
+   end subroutine gbug
+ end program tester