Fortran: Bugs found in class_transformational_1/2.f90[PR116254/118059].

2024-12-23  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/116254
	* trans-array.cc (gfc_trans_create_temp_array): Make sure that
	transformational intrinsics of class objects that change rank,
	most particularly spread, go through the correct code path. Re-
	factor so that changes to the dtype are done on the temporary
	before the class data of the result points to it.

	PR fortran/118059
	* trans-expr.cc (arrayfunc_assign_needs_temporary): Character
	array function expressions assigned to an unlimited polymorphic
	variable require a temporary.

2 files changed, 30 insertions, 20 deletions

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e531dd5..4506c86 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 updated 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 34891af..9aedecb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11445,6 +11445,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;