See the attached patch.
I finally had some time to get back to this one.
Regression tested ob x86_64.
OK for mainline?
Regards,
Jerry
---
fortran: namelist read with repeat count fails when member of array
When processing a namelist with a repeat count and the object is a
component of a derived type, we need to go through the components
and update each one.
PR fortran/82086
libgfortran/ChangeLog:
* io/list_read.c (nml_read_obj): Add is_component parameter
to correctly distribute repeat count across derived-type array
elements.
gcc/testsuite/ChangeLog:
* gfortran.dg/namelist_103.f90: New test.
commit 00ff4597ff7626f80a5c2a556fc1b8b0f8ae835d
Author: Jerry DeLisle <[email protected]>
Date: Fri Jun 19 18:37:52 2026 -0700
fortran: namelist read with repeat count fails when member of array
When processing a namelist with a repeat count and the object is a
component of a derived type, we need to go through the components
and update each one.
PR fortran/82086
libgfortran/ChangeLog:
* io/list_read.c (nml_read_obj): Add is_component parameter
to correctly distribute repeat count across derived-type array
elements.
gcc/testsuite/ChangeLog:
* gfortran.dg/namelist_103.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/namelist_103.f90 b/gcc/testsuite/gfortran.dg/namelist_103.f90
new file mode 100644
index 00000000000..18ecb11ee51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_103.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR fortran/82086 - namelist read of derived-type array component
+! with a repeat count must set all addressed elements.
+program pr82086
+ implicit none
+ type t
+ character(64) :: c = ''
+ end type t
+ type(t), dimension(16) :: ta
+ integer :: i
+ namelist /n/ ta
+
+ open (10, status="scratch", delim="apostrophe")
+ write (10, '(a)') "&n"
+ write (10, '(a)') " ta(1:8)%c = 8*'bogus'"
+ write (10, '(a)') "/"
+ rewind (10)
+ read (10, nml=n)
+ close (10)
+
+ do i = 1, 8
+ if (ta(i)%c /= 'bogus') stop i
+ end do
+ do i = 9, 16
+ if (ta(i)%c /= '') stop 10+i
+ end do
+end program pr82086
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 7b71cf38719..757f2faac23 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2652,7 +2652,8 @@ calls:
static void nml_touch_nodes (namelist_info *nl)
static int nml_read_obj (namelist_info *nl, index_type offset,
namelist_info **prev_nl, char *, size_t,
- index_type clow, index_type chigh)
+ index_type clow, index_type chigh,
+ bool is_component)
calls:
-itself- */
@@ -3123,7 +3124,8 @@ query_return:
static bool
nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
namelist_info **pprev_nl, char *nml_err_msg,
- size_t nml_err_msg_size, index_type clow, index_type chigh)
+ size_t nml_err_msg_size, index_type clow, index_type chigh,
+ bool is_component)
{
namelist_info *cmp;
char *obj_name;
@@ -3142,7 +3144,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
return true;
dtp->u.p.item_count++; /* Used in error messages. */
- dtp->u.p.repeat_count = 0;
+ if (!is_component)
+ dtp->u.p.repeat_count = 0;
eat_spaces (dtp);
len = nl->len;
@@ -3196,9 +3199,60 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
* GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size);
}
+ nml_carry = 0;
+
+ /* A default (non-DTIO) derived type does not itself hold a value to
+ read; only its components do. Recurse into the components on
+ every iteration of the array loop, independently of the repeat
+ count, so that a repeat count parsed while reading one component
+ (e.g. "ta(1:8)%c = 8*'bogus'") gets applied to that component for
+ each addressed array element. */
+
+ if ((nl->type == BT_DERIVED || nl->type == BT_CLASS)
+ && nl->dtio_sub == NULL)
+ {
+ obj_name_len = strlen (nl->var_name) + 1;
+ obj_name = xmalloc (obj_name_len+1);
+ memcpy (obj_name, nl->var_name, obj_name_len-1);
+ memcpy (obj_name + obj_name_len - 1, "%", 2);
+
+ /* If reading a derived type, disable the expanded read warning
+ since a single object can have multiple reads. */
+ dtp->u.p.expanded_read = 0;
+
+ /* Now loop over the components. */
+
+ for (cmp = nl->next;
+ cmp &&
+ !strncmp (cmp->var_name, obj_name, obj_name_len);
+ cmp = cmp->next)
+ {
+ /* Jump over nested derived type by testing if the potential
+ component name contains '%'. */
+ if (strchr (cmp->var_name + obj_name_len, '%'))
+ continue;
+
+ if (!nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
+ pprev_nl, nml_err_msg, nml_err_msg_size,
+ clow, chigh, true))
+ {
+ free (obj_name);
+ return false;
+ }
+
+ if (dtp->u.p.input_complete)
+ {
+ free (obj_name);
+ return true;
+ }
+ }
+
+ free (obj_name);
+ goto incr_idx;
+ }
+
/* If we are finished with the repeat count, try to read next value. */
- nml_carry = 0;
if (--dtp->u.p.repeat_count <= 0)
{
if (dtp->u.p.input_complete)
@@ -3241,8 +3295,8 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
case BT_DERIVED:
case BT_CLASS:
- /* If this object has a User Defined procedure, call it. */
- if (nl->dtio_sub != NULL)
+ /* This object has a User Defined I/O procedure; objects
+ without one were already handled above. */
{
GFC_INTEGER_4 unit = dtp->u.p.current_unit->unit_number;
char iotype[] = "NAMELIST";
@@ -3302,46 +3356,6 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
goto incr_idx;
}
- /* Must be default derived type namelist read. */
- obj_name_len = strlen (nl->var_name) + 1;
- obj_name = xmalloc (obj_name_len+1);
- memcpy (obj_name, nl->var_name, obj_name_len-1);
- memcpy (obj_name + obj_name_len - 1, "%", 2);
-
- /* If reading a derived type, disable the expanded read warning
- since a single object can have multiple reads. */
- dtp->u.p.expanded_read = 0;
-
- /* Now loop over the components. */
-
- for (cmp = nl->next;
- cmp &&
- !strncmp (cmp->var_name, obj_name, obj_name_len);
- cmp = cmp->next)
- {
- /* Jump over nested derived type by testing if the potential
- component name contains '%'. */
- if (strchr (cmp->var_name + obj_name_len, '%'))
- continue;
-
- if (!nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
- pprev_nl, nml_err_msg, nml_err_msg_size,
- clow, chigh))
- {
- free (obj_name);
- return false;
- }
-
- if (dtp->u.p.input_complete)
- {
- free (obj_name);
- return true;
- }
- }
-
- free (obj_name);
- goto incr_idx;
-
default:
snprintf (nml_err_msg, nml_err_msg_size,
"Bad type for namelist object %s", nl->var_name);
@@ -3456,7 +3470,7 @@ incr_idx:
}
} while (!nml_carry);
- if (dtp->u.p.repeat_count > 1)
+ if (!is_component && dtp->u.p.repeat_count > 1)
{
snprintf (nml_err_msg, nml_err_msg_size,
"Repeat count too large for namelist object %s", nl->var_name);
@@ -3780,7 +3794,7 @@ get_name:
dtp->u.p.nml_read_error = 0;
if (!nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
- clow, chigh))
+ clow, chigh, false))
goto nml_err_ret;
return true;
