2006-05-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/24459
	* io/list_read.c (nml_parse_qualifier): Leave loop spec end value
	at default value unless -std=f95 or if an array section
	is specified in namelist input.  Warn if -pedantic.
	* io/io.h (st_parameter_dt): Add expanded_read flag.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@113924 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 774a2b8..7f60106 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2006-05-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/24459
+       * io/list_read.c (nml_parse_qualifier): Leave loop spec end value
+       at default value unless -std=f95 or if an array section
+       is specified in namelist input.  Warn if -pedantic.
+       * io/io.h (st_parameter_dt): Add expanded_read flag.
+
 2006-05-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/22423

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index e7581a6..2d3c185 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -432,7 +432,9 @@ typedef struct st_parameter_dt
          struct format_data *fmt;
          jmp_buf *eof_jump;
          namelist_info *ionml;
-
+         /* A flag used to identify when a non-standard expanded namelist read
+            has occurred.  */
+         int expanded_read;
          /* Storage area for values except for strings.  Must be large
             enough to hold a complex value (two reals) of the largest
             kind.  */

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index ab3965d..0670efa 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1660,8 +1660,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
   int indx;
   int neg;
   int null_flag;
+  int is_array_section;
   char c;
 
+  is_array_section = 0;
+  dtp->u.p.expanded_read = 0;
+
   /* The next character in the stream should be the '('.  */
 
   c = next_char (dtp);
@@ -1700,6 +1704,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
              switch (c)
                {
                case ':':
+                  is_array_section = 1;
                  break;
 
                case ',': case ')':
@@ -1775,7 +1780,14 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
              if (indx == 0)
                {
                  memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
-                 ls[dim].end = ls[dim].start;
+
+                 /*  If -std=f95/2003 or an array section is specified,
+                     do not allow excess data to be processed.  */
+                  if (is_array_section == 1
+                     || compile_options.allow_std < GFC_STD_GNU)
+                   ls[dim].end = ls[dim].start;
+                 else
+                   dtp->u.p.expanded_read = 1;
                }
              break;
            }
@@ -2112,6 +2124,10 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
            strcpy (obj_name, nl->var_name);
            strcat (obj_name, "%");
 
+           /* 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. Update the component pointer
               with the return value from nml_write_obj.  This loop jumps
               past nested derived types by testing if the potential
@@ -2157,11 +2173,16 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
 
       *pprev_nl = nl;
       if (dtp->u.p.nml_read_error)
-       return SUCCESS;
+       {
+         dtp->u.p.expanded_read = 0;
+         return SUCCESS;
+       }
 
       if (dtp->u.p.saved_type == GFC_DTYPE_UNKNOWN)
-       goto incr_idx;
-
+       {
+         dtp->u.p.expanded_read = 0;
+         goto incr_idx;
+       }
 
       /* Note the switch from GFC_DTYPE_type to BT_type at this point.
         This comes about because the read functions return BT_types.  */
@@ -2182,14 +2203,27 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
          memcpy (pdata, dtp->u.p.saved_string, m);
          if (m < dlen)
            memset ((void*)( pdata + m ), ' ', dlen - m);
-       break;
+         break;
 
        default:
          break;
       }
 
-      /* Break out of loop if scalar.  */
+      /* Warn if a non-standard expanded read occurs. A single read of a
+        single object is acceptable.  If a second read occurs, issue a warning
+        and set the flag to zero to prevent further warnings.  */
+      if (dtp->u.p.expanded_read == 2)
+       {
+         notify_std (GFC_STD_GNU, "Non-standard expanded namelist read.");
+         dtp->u.p.expanded_read = 0;
+       }
+
+      /* If the expanded read warning flag is set, increment it,
+        indicating that a single read has occured.  */
+      if (dtp->u.p.expanded_read >= 1)
+       dtp->u.p.expanded_read++;
 
+      /* Break out of loop if scalar.  */
       if (!nl->var_rank)
        break;
 
@@ -2500,6 +2534,7 @@ namelist_read (st_parameter_dt *dtp)
 
   dtp->u.p.namelist_mode = 1;
   dtp->u.p.input_complete = 0;
+  dtp->u.p.expanded_read = 0;
 
   dtp->u.p.eof_jump = &eof_jump;
   if (setjmp (eof_jump))