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 (file)
index 0000000..18ecb11
--- /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 7b71cf38719deb6e3dbe0a22c0cca546b8fb43c1..757f2faac238fe8034068aac990c2f207b3a52ad 100644 (file)
--- 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,
       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-  */
 
 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,
 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;
 {
   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.  */
     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;
   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);
        }
 
              * 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.  */
 
       /* 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)
       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:
 
          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";
              {
                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;
              }
 
                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);
           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);
 
         }
     } 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);
     {
       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,
 
   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;
     goto nml_err_ret;
 
   return true;