re PR libfortran/24459 ([4.1 Only] gfortran namelist problem)

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.

From-SVN: r113924

libgfortran/ChangeLog

+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

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.  */

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))