On 8/25/26 5:09 AM, Mikael Morin wrote:
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.
--- snip ---
This looks a lot better, similar in both places:
+ if (fsym->ts.type == BT_DERIVED && fsym->ts.u.derived->attr.alloc_comp)
+ {
+ tree src_ptr = fold_convert (build_pointer_type (eltype), src);
+ tree elem_idx = gfc_create_var (gfc_array_index_type, "elem");
+ tree dest_elem = gfc_build_array_ref (tmpvar, elem_idx, NULL_TREE);
+ tree src_offset = fold_build2_loc (input_location, MULT_EXPR, sizetype,
+ fold_convert (sizetype, elem_idx),
+ eltsize);
+ tree src_elem
+ = build_fold_indirect_ref_loc (input_location,
+ fold_build_pointer_plus_loc
+ (input_location, src_ptr, src_offset));
+
+ tmp = gfc_copy_alloc_comp (fsym->ts.u.derived, src_elem, dest_elem, 0,
0);
+ gfc_simple_for_loop (&parmse->pre, elem_idx, gfc_index_zero_node, nelems,
+ LT_EXPR, gfc_index_one_node, tmp);
+
+ tmp = gfc_deallocate_alloc_comp (fsym->ts.u.derived, dest_elem, 0);
+ gfc_simple_for_loop (&parmse->post, elem_idx, gfc_index_zero_node,
nelems,
+ LT_EXPR, gfc_index_one_node, tmp);
+ }
+
Regression tested after the change. Your other comments incorporated as well.
OK?
Jerry
