See attached patch. I reworked this one from that posted in the PR some time
ago.
This is a wrong code of the worst kind because gfortran was silently giving
incorrect results.
Regression tested on x86_64.
OK for mainline, we should consider backporting this because of the nature of
the error.
Best regards,
Jerry
---
fortran: [PR125722] wrong code for an allocatable character array component
A structure constructor copying an allocatable or deferred-length character
array expression into an explicit-length allocatable character array component
was lowered with gfc_duplicate_allocatable, which bitwise-copies the source at
the destination element stride. When the source element length differs from
the component length this copies the wrong bytes, so every element after the
first is wrong.
Copy such a component element by element with gfc_trans_string_copy, padding or
truncating each element to the component length.
PR fortran/125722
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_char_elem_addr): New function.
(gfc_trans_alloc_char_subarray_assign): New function.
(gfc_trans_alloc_subarray_assign): Use it for an explicit-length
allocatable character array component.
gcc/testsuite/ChangeLog:
* gfortran.dg/structure_constructor_22.f90: New test.
---commit 3025fa8537c12a85bf23766599298a7abc8d9211
Author: Jerry DeLisle <[email protected]>
Date: Thu Aug 27 08:59:06 2026 -0700
fortran: [PR125722] wrong code for an allocatable character array component
A structure constructor copying an allocatable or deferred-length character
array expression into an explicit-length allocatable character array component
was lowered with gfc_duplicate_allocatable, which bitwise-copies the source at
the destination element stride. When the source element length differs from
the component length this copies the wrong bytes, so every element after the
first is wrong.
Copy such a component element by element with gfc_trans_string_copy, padding or
truncating each element to the component length.
PR fortran/125722
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_char_elem_addr): New function.
(gfc_trans_alloc_char_subarray_assign): New function.
(gfc_trans_alloc_subarray_assign): Use it for an explicit-length
allocatable character array component.
gcc/testsuite/ChangeLog:
* gfortran.dg/structure_constructor_22.f90: New test.
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 9c922e998c3..a4138b2b369 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10081,6 +10081,83 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
static stmtblock_t *final_block;
+
+
+/* Get the address of element index of contiguous character array data whose elements
+ are len characters of ksize bytes each. */
+
+static tree
+gfc_char_elem_addr (tree char_ptr, tree data, tree idx, tree len, tree ksize)
+{
+ tree offset = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, len, ksize);
+ offset = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ idx, offset);
+ return fold_build_pointer_plus_loc (input_location,
+ fold_convert (char_ptr, data), offset);
+}
+
+
+/* Copy a deferred-shape allocatable character array component in a structure
+ constructor when the source element length (SRC_LEN) may differ from the
+ component's declared length. Like gfc_duplicate_allocatable, a
+ contiguous source layout is assumed. DEST and SRC are array descriptors;
+ DEST already carries the source's bounds. */
+
+static tree
+gfc_trans_alloc_char_subarray_assign (tree dest, gfc_component *cm, tree src,
+ tree src_len, int rank)
+{
+ stmtblock_t block, body;
+ tree dlen, slen, ksize, nelems, idx, size, tmp, pchar, cond;
+
+ gfc_init_block (&block);
+
+ pchar = gfc_get_pchar_type (cm->ts.kind);
+ ksize = fold_convert (gfc_array_index_type,
+ TYPE_SIZE_UNIT (gfc_get_char_type (cm->ts.kind)));
+ dlen = fold_convert (gfc_array_index_type, cm->ts.u.cl->backend_decl);
+ slen = fold_convert (gfc_array_index_type, src_len);
+ nelems = gfc_full_array_size (&block, src, rank);
+ nelems = gfc_evaluate_now (nelems, &block);
+
+ /* Allocate the destination data: nelems elements of the component length. */
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ nelems, dlen);
+ size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+ size, ksize);
+ tmp = TREE_TYPE (gfc_conv_descriptor_data_get (dest));
+ gfc_conv_descriptor_data_set (&block, dest,
+ gfc_call_malloc (&block, tmp, size));
+
+ /* Copy element IDX, padding or truncating to the component length. */
+ idx = gfc_create_var (gfc_array_index_type, "idx");
+ gfc_init_block (&body);
+ gfc_trans_string_copy (&body, cm->ts.u.cl->backend_decl,
+ gfc_char_elem_addr (pchar,
+ gfc_conv_descriptor_data_get (dest),
+ idx, dlen, ksize),
+ cm->ts.kind, src_len,
+ gfc_char_elem_addr (pchar,
+ gfc_conv_descriptor_data_get (src),
+ idx, slen, ksize),
+ cm->ts.kind);
+ gfc_simple_for_loop (&block, idx, gfc_index_zero_node, nelems, LT_EXPR,
+ gfc_index_one_node, gfc_finish_block (&body));
+
+ tmp = gfc_finish_block (&block);
+
+ /* Null the destination if the source is unallocated. */
+ gfc_init_block (&body);
+ gfc_conv_descriptor_data_set (&body, dest, null_pointer_node);
+ cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+ fold_convert (pvoid_type_node,
+ gfc_conv_descriptor_data_get (src)),
+ null_pointer_node);
+ return build3_v (COND_EXPR, cond, tmp, gfc_finish_block (&body));
+}
+
+
static tree
gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
gfc_expr * expr)
@@ -10143,6 +10220,13 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
tmp = gfc_duplicate_allocatable (dest, se.expr,
gfc_typenode_for_spec (&cm->ts),
cm->as->rank, NULL_TREE);
+ else if (cm->ts.type == BT_CHARACTER)
+ /* Explicit-length character: the source element length may differ from
+ the component length, so a bitwise duplicate would copy the wrong
+ bytes. Copy element by element with padding/truncation. */
+ tmp = gfc_trans_alloc_char_subarray_assign (dest, cm, se.expr,
+ se.string_length,
+ cm->as->rank);
else
tmp = gfc_duplicate_allocatable (dest, se.expr,
TREE_TYPE(cm->backend_decl),
diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_22.f90 b/gcc/testsuite/gfortran.dg/structure_constructor_22.f90
new file mode 100644
index 00000000000..7dbfe27c4a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/structure_constructor_22.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+!
+! PR125722
+!
+program p
+ type t
+ character(2), allocatable :: c(:)
+ end type t
+ type(t) :: x
+
+ character(:), allocatable :: d(:)
+ character(2), allocatable :: e(:)
+
+ ! Deferred-length source longer than the component -> truncate each element.
+ allocate (character(5) :: d(3))
+ d = [ "abcde", "fghij", "klmno" ]
+ x = t (d)
+ if (size (x%c) /= 3) stop 1
+ if (len (x%c) /= 2) stop 2
+ if (x%c(1) /= "ab") stop 3
+ if (x%c(2) /= "fg") stop 4
+ if (x%c(3) /= "kl") stop 5
+
+ ! Deferred-length source shorter than the component -> blank pad.
+ deallocate (d)
+ allocate (character(1) :: d(2))
+ d = [ "p", "q" ]
+ x = t (d)
+ if (x%c(1) /= "p ") stop 6
+ if (x%c(2) /= "q ") stop 7
+
+ ! Explicit-length allocatable source, equal length.
+ allocate (e(2))
+ e = [ "xy", "zw" ]
+ x = t (e)
+ if (x%c(1) /= "xy") stop 8
+ if (x%c(2) /= "zw") stop 9
+end program p
