Re: [patch, libgfortran] Fix PR24459 Namelist problem

[Jerry DeLisle <jvdelisle at verizon dot net>]

:REVIEWMAIL:

The attached is an updated patch against current trunk.  This patch revises the 
behavior as follows:

With no compile options (ie. -std=gnu or default) the expanded namelist read 
behavior is allowed.

With -pedantic a run time warning is issued using existing std_notify functions 
if a non-standard read occurs.

With -std=f95 a run time error is issued if a non-standard read occurs.

A review of the patch will show handling a few corner cases that resulted in 
emitting warnings when we should not.  These false warnings are avoided by 
setting the expanded_read flag to zero in those cases.

I have attached the test case that was submitted before.  I could have included 
a -pedantic on that and check for dg-output but I did not think I needed to test 
this in the test-suite since the std_notify function exists already and is tested.

OK to commit to trunk and then 4.1?

Regards,

Jerry

2006-05-16  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.

Index: io/list_read.c
===================================================================
*** io/list_read.c	(revision 113836)
--- io/list_read.c	(working copy)
*************** nml_parse_qualifier (st_parameter_dt *dt
*** 1660,1667 ****
--- 1660,1671 ----
    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);
*************** nml_parse_qualifier (st_parameter_dt *dt
*** 1700,1705 ****
--- 1704,1710 ----
  	      switch (c)
  		{
  		case ':':
+                   is_array_section = 1;
  		  break;
  
  		case ',': case ')':
*************** nml_parse_qualifier (st_parameter_dt *dt
*** 1775,1781 ****
  	      if (indx == 0)
  		{
  		  memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
! 		  ls[dim].end = ls[dim].start;
  		}
  	      break;
  	    }
--- 1780,1793 ----
  	      if (indx == 0)
  		{
  		  memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
! 
! 		  /*  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;
  	    }
*************** nml_read_obj (st_parameter_dt *dtp, name
*** 2112,2117 ****
--- 2124,2133 ----
  	    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
*************** nml_read_obj (st_parameter_dt *dtp, name
*** 2157,2167 ****
  
        *pprev_nl = nl;
        if (dtp->u.p.nml_read_error)
! 	return SUCCESS;
  
        if (dtp->u.p.saved_type == GFC_DTYPE_UNKNOWN)
! 	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.  */
--- 2173,2188 ----
  
        *pprev_nl = nl;
        if (dtp->u.p.nml_read_error)
! 	{
! 	  dtp->u.p.expanded_read = 0;
! 	  return SUCCESS;
! 	}
  
        if (dtp->u.p.saved_type == GFC_DTYPE_UNKNOWN)
! 	{
! 	  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.  */
*************** nml_read_obj (st_parameter_dt *dtp, name
*** 2182,2195 ****
  	  memcpy (pdata, dtp->u.p.saved_string, m);
  	  if (m < dlen)
  	    memset ((void*)( pdata + m ), ' ', dlen - m);
! 	break;
  
  	default:
  	  break;
        }
  
!       /* Break out of loop if scalar.  */
  
        if (!nl->var_rank)
  	break;
  
--- 2203,2229 ----
  	  memcpy (pdata, dtp->u.p.saved_string, m);
  	  if (m < dlen)
  	    memset ((void*)( pdata + m ), ' ', dlen - m);
! 	  break;
  
  	default:
  	  break;
        }
  
!       /* 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;
  
*************** namelist_read (st_parameter_dt *dtp)
*** 2500,2505 ****
--- 2534,2540 ----
  
    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))
Index: io/io.h
===================================================================
*** io/io.h	(revision 113836)
--- io/io.h	(working copy)
*************** typedef struct st_parameter_dt
*** 432,438 ****
  	  struct format_data *fmt;
  	  jmp_buf *eof_jump;
  	  namelist_info *ionml;
! 
  	  /* Storage area for values except for strings.  Must be large
  	     enough to hold a complex value (two reals) of the largest
  	     kind.  */
--- 432,440 ----
  	  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.  */

Attachment: namelist_24.f90
Description: application/extension-f90