re PR fortran/88980 (segfault on allocatable string member assignment)

2019-02-02  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-02  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r268473

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1dc007d1a2e9b0afc8f88a1681350d26767b0dbc..6dba135459fac039d0dfc49726c282723f508952 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2019-02-02  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-02  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/88685

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6d7c3d221542787d5fe870e530d9f07609cd9802..b885fe6187dce6a259564fbd8ba23df906c9cb88 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5370,14 +5370,14 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
                     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 expr3_desc, bool e3_has_nodescriptor, gfc_expr *expr,
+                    tree *element_size)
 {
   tree type;
   tree tmp;
   tree size;
   tree offset;
   tree stride;
-  tree element_size;
   tree or_expr;
   tree thencase;
   tree elsecase;
@@ -5628,10 +5628,10 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
     tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
 
   /* Convert to size_t.  */
-  element_size = fold_convert (size_type_node, tmp);
+  *element_size = fold_convert (size_type_node, tmp);
 
   if (rank == 0)
-    return element_size;
+    return *element_size;
 
   *nelems = gfc_evaluate_now (stride, pblock);
   stride = fold_convert (size_type_node, stride);
@@ -5641,14 +5641,14 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
      dividing.  */
   tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
                         size_type_node,
-                        TYPE_MAX_VALUE (size_type_node), element_size);
+                        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,
+                                       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,
@@ -5658,7 +5658,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   *overflow = gfc_evaluate_now (tmp, pblock);
 
   size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
-                         stride, element_size);
+                         stride, *element_size);
 
   if (poffset != NULL)
     {
@@ -5736,6 +5736,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
   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;
@@ -5852,7 +5853,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
                              &offset, lower, upper,
                              &se->pre, &set_descriptor_block, &overflow,
                              expr3_elem_size, nelems, expr3, e3_arr_desc,
-                             e3_has_nodescriptor, expr);
+                             e3_has_nodescriptor, expr, &element_size);
 
   if (dimension)
     {
@@ -5924,38 +5925,11 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  /* Update the array descriptors.  */
+  /* Update the array descriptor with the offset and the span.  */
   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_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);
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bc9ca4c289ce9314ad4ac480296c5b2f0c80bf9d..d94a3be174641677a368f7cde9c24ca311f99f1c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/88980
+       * gfortran.dg/realloc_on_assign_32.f90 : New test.
+
 2019-02-02  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/88685

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90
new file mode 100644 (file)
index 0000000..31a0d76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_32.f90
@@ -0,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