From d21efb65d15273d50ca80aea14787efa6245174c Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Mon, 23 Dec 2024 15:32:40 +0000
Subject: [PATCH] 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.
---
gcc/fortran/trans-array.cc | 47 ++++++++++++++++++++++----------------
gcc/fortran/trans-expr.cc | 3 +++
2 files changed, 30 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e531dd5efb7b..4506c86f166c 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 34891afb54ce..9aedecb9780e 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;
--
GitLab