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 <jvdeli...@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.
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;
! { dg-do run }
! PR56660 Fails to read NAMELIST with certain form array syntax
type ptracer
character(len = 2) :: sname
logical :: lini
end type ptracer
type(ptracer) , dimension(3) :: tracer
namelist/naml1/ tracer
tracer(:) = ptracer('XXX', .false.)
open (99, file='nml.dat', status="replace")
write(99,*) "&naml1"
!write(99,*) " tracer(2) = 'bb' , .true."
write(99,*) " tracer(:) = 'aa' , .true."
write(99,*) " tracer(2) = 'bb' , .true."
write(99,*) "/"
rewind(99)
read (99, nml=naml1)
close (99, status="delete")
if (tracer(1)%sname.ne.'aa') call abort()
if (.not.tracer(1)%lini) call abort()
if (tracer(2)%sname.ne.'bb') call abort()
if (.not.tracer(2)%lini) call abort()
if (tracer(3)%sname.ne.'XX') call abort()
if (tracer(3)%lini) call abort()
!write (*, nml=naml1)
end
