[Patch, fortran] PR116254/118059 -[15 Regression] Bugs triggered by class_transformational_1/2.f90

[Paul Richard Thomas]

Hi All,

These bugs were tricky to find because neither were detected by regression
testing on my platform.

PR116254: This bug was sporadic even where the regression was detected.
Richard Sandiford found "Conditional jump or move depends on uninitialised
value" errors in the library, triggered  by the test for for spread in
class_transformational_2.f90. Mea culpa, I had failed to notice this.
It turned out that, alone of the rank changing intrinsic functions, spread
was going through the wrong code path. This is fixed by the
explicit condition in the patch.

Richard also noted that spread results are being copied from uninitialised
memory. This was not quite correct because the library function was doing
the job on detection of the NULL descriptor data field. Nevertheless, I
have refactored slightly to ensure that the temporary descriptor has its
dtype field set correctly before the class data is pointed at it. Valgrind
shows both class_transformational tests to now be as clean as a whistle.

PR118059: The reporter found, with an ubsan instrumented gcc, that
class_transformational_1.f90 was generating an invalid value for type
'expr_t' in gcc/fortran/trans-expr.cc. The offending statement is; B =
reshape (chr, [5, 1, 2]), where 'B' is unlimited polymorphic. This requires
a trivial fix since the assignment of a character array valued function to
an unlimited polymorphic variable unconditionally requires a temporary.

Regression tests without errors - OK for mainline?

Seasons greetings to one and all.

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 82a2ae1f747..3132443b4d9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1632,9 +1632,20 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
       tree class_data;
       tree dtype;
       gfc_expr *expr1 = fcn_ss ? fcn_ss->info->expr : NULL;
+      bool rank_changer;
+
+      /* Pick out these transformational functions because they change the rank
+	 or shape of the first argument. This requires that the class type be
+	 changed, the dtype updating and the correct rank used.  */
+      rank_changer = expr1 && expr1->expr_type == EXPR_FUNCTION
+		     && expr1->value.function.isym
+		     && (expr1->value.function.isym->id == GFC_ISYM_RESHAPE
+			 || expr1->value.function.isym->id == GFC_ISYM_SPREAD
+			 || expr1->value.function.isym->id == GFC_ISYM_PACK
+			 || expr1->value.function.isym->id == GFC_ISYM_UNPACK);
 
       /* Create a class temporary for the result using the lhs class object.  */
-      if (class_expr != NULL_TREE)
+      if (class_expr != NULL_TREE && !rank_changer)
 	{
 	  tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
 	  gfc_add_modify (pre, tmp, class_expr);
@@ -1672,33 +1683,29 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
 	  elemsize = gfc_evaluate_now (elemsize, pre);
 	}
 
-      /* Assign the new descriptor to the _data field. This allows the
-	 vptr _copy to be used for scalarized assignment since the class
-	 temporary can be found from the descriptor.  */
       class_data = gfc_class_data_get (tmp);
-      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
-			     TREE_TYPE (desc), desc);
-      gfc_add_modify (pre, class_data, tmp);
 
-      if (expr1 && expr1->expr_type == EXPR_FUNCTION
-	  && expr1->value.function.isym
-	  && (expr1->value.function.isym->id == GFC_ISYM_RESHAPE
-	      || expr1->value.function.isym->id == GFC_ISYM_UNPACK))
+      if (rank_changer)
 	{
 	  /* Take the dtype from the class expression.  */
 	  dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
-	  tmp = gfc_conv_descriptor_dtype (class_data);
+	  tmp = gfc_conv_descriptor_dtype (desc);
 	  gfc_add_modify (pre, tmp, dtype);
 
-	  /* Transformational functions reshape and reduce can change the rank.  */
-	  if (fcn_ss && fcn_ss->info && fcn_ss->info->class_container)
-	    {
-	      tmp = gfc_conv_descriptor_rank (class_data);
-	      gfc_add_modify (pre, tmp,
-			      build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
-	      fcn_ss->info->class_container = NULL_TREE;
-	    }
+	  /* These transformational functions change the rank.  */
+	  tmp = gfc_conv_descriptor_rank (desc);
+	  gfc_add_modify (pre, tmp,
+			  build_int_cst (TREE_TYPE (tmp), ss->loop->dimen));
+	  fcn_ss->info->class_container = NULL_TREE;
 	}
+
+      /* Assign the new descriptor to the _data field. This allows the
+	 vptr _copy to be used for scalarized assignment since the class
+	 temporary can be found from the descriptor.  */
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (desc), desc);
+      gfc_add_modify (pre, class_data, tmp);
+
       /* Point desc to the class _data field.  */
       desc = class_data;
     }
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 44a50c0edb1..83474ea6770 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11393,6 +11393,9 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
      character lengths are the same.  */
   if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
     {
+      if (UNLIMITED_POLY (expr1))
+	return true;
+
       if (expr1->ts.u.cl->length == NULL
 	    || expr1->ts.u.cl->length->expr_type != EXPR_CONSTANT)
 	return true;