Le 25/08/2026 à 01:37, Jerry D a écrit :
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 32972d9c84a..ff09a0f0f1f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6717,6 +6717,207 @@ gfc_const_length_character_type_p (gfc_typespec *ts)
}
+/* Returns true if FORMAL contains an explicit-shape array dummy with the
+ VALUE attribute. The bounds of such a dummy may have to be evaluated
+ on the caller side, which needs an interface mapping. */
+
+static bool
+has_value_array_dummy (gfc_formal_arglist *formal)
+{
+ for (; formal; formal = formal->next)
+ if (formal->sym && formal->sym->attr.value && formal->sym->attr.dimension
+ && formal->sym->as && formal->sym->as->type == AS_EXPLICIT)
+ return true;
+
+ return false;
+}
+
+
+/* Sequence association (F2023, 15.5.2.12) of a scalar actual argument E with
+ an explicit-shape array dummy FSYM that has the VALUE attribute. Copy as
+ many elements as the dummy declares into a temporary and pass that.
+ MAPPING supplies the caller-side values of any dummy arguments appearing
+ in the bounds or the character length of FSYM. */
+
+static void
+conv_seq_assoc_value_arg (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
+ gfc_interface_mapping *mapping)
+{
(...)
+ /* The memcpy also copied the component pointers of a derived type, which
+ would leave the temporary sharing the actual argument's allocatable
+ components. Give the copy components of its own and free them again
+ once the call has returned. */
+ if (fsym->ts.type == BT_DERIVED && fsym->ts.u.derived->attr.alloc_comp)
+ {
+ tree srcp = fold_convert (build_pointer_type (eltype), src);
+
+ for (n = 0; n < 2; n++)
+ {
+ stmtblock_t loop_block, body;
+ tree idx, exit_label, delt;
+
+ idx = gfc_create_var (gfc_array_index_type, "idx");
+ exit_label = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (exit_label) = 1;
+
+ gfc_start_block (&loop_block);
+ gfc_add_modify (&loop_block, idx, gfc_index_zero_node);
+
+ gfc_start_block (&body);
+ tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+ idx, nelems);
+ tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, exit_label),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&body, tmp);
+
+ delt = gfc_build_array_ref (tmpvar, idx, NULL_TREE);
+ if (n == 0)
+ {
+ tree off = fold_build2_loc (input_location, MULT_EXPR, sizetype,
+ fold_convert (sizetype, idx),
eltsize);
+ tree selt
+ = build_fold_indirect_ref_loc (input_location,
+ fold_build_pointer_plus_loc
+ (input_location, srcp, off));
+ tmp = gfc_copy_alloc_comp (fsym->ts.u.derived, selt, delt, 0, 0);
+ }
+ else
+ tmp = gfc_deallocate_alloc_comp (fsym->ts.u.derived, delt, 0);
+ gfc_add_expr_to_block (&body, tmp);
+
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type,
+ idx, gfc_index_one_node);
+ gfc_add_modify (&body, idx, tmp);
+
+ gfc_add_expr_to_block (&loop_block,
+ build1_v (LOOP_EXPR, gfc_finish_block
(&body)));
+ gfc_add_expr_to_block (&loop_block, build1_v (LABEL_EXPR,
exit_label));
+
+ tmp = gfc_finish_block (&loop_block);
+ if (n == 0)
+ gfc_add_expr_to_block (&parmse->pre, tmp);
+ else
+ gfc_add_expr_to_block (&parmse->post, tmp);
+ }
Would you mind rewriting this without loop? gfc_simple_for_loop can
probably be used to simplify loop generation. And then what remains is
the index variable generation (the same can be used for both loops), and
then mostly the central if (n == 0) ... else ... remains.
+ }
+
+ if (fsym->ts.type == BT_CHARACTER)
+ parmse->expr
+ = gfc_build_addr_expr (build_pointer_type (gfc_get_char_type
+ (fsym->ts.kind)), tmpvar);
+ else
+ parmse->expr = gfc_build_addr_expr (build_pointer_type (eltype), tmpvar);
+}
+
+
/* Helper function for the handling of (currently) scalar dummy variables
with the VALUE attribute. Argument parmse should already be set up. */
static void
@@ -7162,7 +7363,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
(sym->ts.type == BT_CHARACTER
&& sym->ts.u.cl->length
&& sym->ts.u.cl->length->expr_type
- != EXPR_CONSTANT);
+ != EXPR_CONSTANT) ||
+ has_value_array_dummy (formal);
formatting nit: the || operator should be on the next line.
}
else
{
@@ -7171,7 +7373,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
(comp->ts.type == BT_CHARACTER
&& comp->ts.u.cl->length
&& comp->ts.u.cl->length->expr_type
- != EXPR_CONSTANT);
+ != EXPR_CONSTANT) ||
+ has_value_array_dummy (formal);
Ditto.
}
base_object = NULL_TREE;
