Correction régression class_elemental_1.f90

This commit is contained in:
Mikael Morin 2025-10-13 22:25:44 +02:00
parent cf68659896
commit f033b6affb
2 changed files with 9 additions and 5 deletions

View File

@ -2836,6 +2836,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
&& se.expr && se.expr
&& GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))) && GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
{ {
ss_info->class_container = se.expr;
tree tmp = gfc_class_data_get (se.expr); tree tmp = gfc_class_data_get (se.expr);
info->descriptor = tmp; info->descriptor = tmp;
info->data = gfc_conv_descriptor_data_get (tmp); info->data = gfc_conv_descriptor_data_get (tmp);
@ -4059,6 +4060,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar,
void void
gfc_conv_tmp_array_ref (gfc_se * se) gfc_conv_tmp_array_ref (gfc_se * se)
{ {
se->class_container = se->ss->info->class_container;
se->string_length = se->ss->info->string_length; se->string_length = se->ss->info->string_length;
gfc_conv_scalarized_array_ref (se, NULL, true); gfc_conv_scalarized_array_ref (se, NULL, true);
gfc_advance_se_ss_chain (se); gfc_advance_se_ss_chain (se);

View File

@ -1234,7 +1234,9 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
} }
if ((ref == NULL || class_ref == ref) if ((ref == NULL || class_ref == ref)
&& !(gfc_is_class_array_function (e) && parmse->class_vptr != NULL_TREE) && !(gfc_is_class_array_function (e)
&& (parmse->class_vptr != NULL_TREE
|| parmse->class_container != NULL_TREE))
&& (!class_ts.u.derived->components->as && (!class_ts.u.derived->components->as
|| class_ts.u.derived->components->as->rank != -1)) || class_ts.u.derived->components->as->rank != -1))
return; return;
@ -1316,6 +1318,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
if (gfc_is_class_array_function (e) if (gfc_is_class_array_function (e)
&& parmse->class_vptr != NULL_TREE) && parmse->class_vptr != NULL_TREE)
tmp = parmse->class_vptr; tmp = parmse->class_vptr;
else if (parmse->class_container != NULL_TREE)
/* Don't redundantly evaluate the expression if the required information
is already available. */
tmp = parmse->class_container;
else if (class_ref == NULL else if (class_ref == NULL
&& e->symtree && e->symtree->n.sym->ts.type == BT_CLASS) && e->symtree && e->symtree->n.sym->ts.type == BT_CLASS)
{ {
@ -1329,10 +1335,6 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
slen = build_zero_cst (size_type_node); slen = build_zero_cst (size_type_node);
} }
else if (parmse->class_container != NULL_TREE)
/* Don't redundantly evaluate the expression if the required information
is already available. */
tmp = parmse->class_container;
else else
{ {
/* Remove everything after the last class reference, convert the /* Remove everything after the last class reference, convert the