Patchwork [libfortran] PR56660 Fails to read NAMELIST with certain form array syntax

login
register
mail settings
Submitter jerry DeLisle
Date April 1, 2013, 6:33 p.m.
Message ID <5159D307.1040405@charter.net>
Download mbox | patch
Permalink /patch/232787/
State New
Headers show

Comments

jerry DeLisle - April 1, 2013, 6:33 p.m.
Hi all,

When doing namelist reads, nml_read_obj calls itself recursively to read through
arrays.  Short lists are allowed so we have to have a way to detect if we have a
short read or a real error.

We do this by flagging errors and then backing out of the read and checking to
see if what we error-ed on was a valid object name rather than data. This is
problematic for reading strings or logicals, since the data can look like names.
 To resolve the problem, we use a line_buffer to hold reads as we look ahead and
if we find an error we rewind, bail out of the read, and proceed to the next
read cycle which looks for an object name followed by an "=" sign.

With this particular bug, nml_read_obj was clearing the error flag itself with
the read so that rather then bailing out, it tried to continue reading data
until it was done, then the subsequent read failed looking for a valid name,
which had been passed by.

The problem is resolved by moving the error flag reset outside nml_read_obj just
before the call to nml_read_obj.  Also, we test the flag on entering
nml_read_obj, and if it is set, we bail out right away, a do nothing, until the
parent nml_read_obj finishes its loops.

Regression tested on x86-64.  Test case attached.

OK for trunk?

Jerry

2013-04-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/56660
	* io/list_read.c (nml_read_obj): Do not reset the read error flag
	inside nml_read_obj. If the read error flag is found set just exit.
	Fix some whitespace on comments.
	(nml_read_obj_data): Reset the read error flag before the first call
	to nml_read_object.
Tobias Burnus - April 1, 2013, 7:37 p.m.
Am 01.04.2013 20:33, schrieb Jerry DeLisle:
> With this particular bug, nml_read_obj was clearing the error flag itself with
> the read so that rather then bailing out, it tried to continue reading data
> until it was done, then the subsequent read failed looking for a valid name,
> which had been passed by.
>
> The problem is resolved by moving the error flag reset outside nml_read_obj just
> before the call to nml_read_obj.  Also, we test the flag on entering
> nml_read_obj, and if it is set, we bail out right away, a do nothing, until the
> parent nml_read_obj finishes its loops.
>
> Regression tested on x86-64.  Test case attached.
> OK for trunk?

OK - and thanks for the patch!

* * *

Do we want to close PR 56786? While it is a regression from 4.6, it 
seems to only occur for slightly invalid namelists - unless, I missed 
some fineprint. Or do we want to backport it to all/some of 4.6 / 4.7 / 
4.8?

* * *

The test case below is motivated by this PR56660 and the original 
PR49791. It fails with "Cannot match namelist object name 'cc'". I was 
wondering whether we should support that extended read (= vendor 
extension) or not. Ifort and g95 do; pathf95, Crayftn, pgf95 and NAG don't.
(gfortran supports the extended read for simpler variants, e.g. PR49791, 
comment 0 and comment 18.)

Tobias


type ptracer
    character(len = 2)  :: sname
    logical              :: lini
end type ptracer
type(ptracer) , dimension(3) :: tracer
namelist/naml1/  tracer

tracer(:) = ptracer('XXX', .false.)
write (*, nml=naml1)

open (99, file='nml.dat', status="replace")
write(99,*) "&naml1"
write(99,*) "   tracer(:)   = 'aa' , .true."
write(99,*) "   tracer(2)   = 'bb' , .true., 'cc', .true."   ! Extended 
read: Two DT elements
write(99,*) "/"
rewind(99)
read (99, nml=naml1)
write (*, nml=naml1)
close (99, status="delete")
end

Patch

Index: list_read.c
===================================================================
--- list_read.c	(revision 197290)
+++ list_read.c	(working copy)
@@ -2490,9 +2490,9 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info
   size_t obj_name_len;
   void * pdata;
 
-  /* This object not touched in name parsing.  */
-
-  if (!nl->touched)
+  /* If we have encountered a previous read error or this object has not been
+     touched in name parsing, just return.  */
+  if (dtp->u.p.nml_read_error || !nl->touched)
     return true;
 
   dtp->u.p.repeat_count = 0;
@@ -2532,10 +2532,8 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info
 				 - GFC_DESCRIPTOR_LBOUND(nl,dim))
 			* GFC_DESCRIPTOR_STRIDE(nl,dim) * nl->size);
 
-      /* Reset the error flag and try to read next value, if
-	 dtp->u.p.repeat_count=0  */
+      /* If we are finished with the repeat count, try to read next value.  */
 
-      dtp->u.p.nml_read_error = 0;
       nml_carry = 0;
       if (--dtp->u.p.repeat_count <= 0)
 	{
@@ -2564,8 +2562,8 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info
 	    break;
 
 	  case BT_REAL:
-	    /* Need to copy data back from the real location to the temp in order
-	       to handle nml reads into arrays.  */
+	    /* Need to copy data back from the real location to the temp in
+	       order to handle nml reads into arrays.  */
 	    read_real (dtp, pdata, len);
 	    memcpy (dtp->u.p.value, pdata, dlen);
 	    break;
@@ -3022,6 +3020,7 @@  get_name:
 	nl = first_nl;
     }
 
+  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))
     goto nml_err_ret;