Dear All,
I found the problem: Alone of all the list_read.c read_type routines,
read_character does not call free_saved () upon exiting. This is
because the character string is stored there and has to be available
for repeat counts. The fault occurred with characters because the
data in the saved string was being carried over to the next io call.
Other types clean up after them, which is why a namelist with a
character and any other type works correctly.
Please find a patch, a testcase and ChangeLog entries below.
Bubblestrapped and regtested on FC3/i686
I intend to commit tonight to mainline and 4.0, under the obvious
rule, unless anybody objects in the next couple of hours.
Cheers
Paul T
2005-10-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24416
* libgfortran/io/list_read.c (namelist_read): Exit with call to
free_saved () so that character strings do not accumulate.
2005-10-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24416
gfortran.dg/namelist_char_only.f90: New test.
Index: gcc/libgfortran/io/list_read.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/list_read.c,v
retrieving revision 1.28
diff -c -p -r1.28 list_read.c
*** gcc/libgfortran/io/list_read.c 26 Sep 2005 20:24:44 -0000 1.28
--- gcc/libgfortran/io/list_read.c 24 Oct 2005 18:40:04 -0000
*************** find_nml_name:
*** 2364,2376 ****
}
}
!
return;
/* All namelist error calls return from here */
nml_err_ret:
generate_error (ERROR_READ_VALUE , nml_err_msg);
return;
}
--- 2364,2377 ----
}
}
! free_saved ();
return;
/* All namelist error calls return from here */
nml_err_ret:
+ free_saved ();
generate_error (ERROR_READ_VALUE , nml_err_msg);
return;
}
====================namelist_char_only.f90======================
! { dg-do run }
! { dg-options "-O0" }
! Test patch for PR24416.f90 - 'a' used to come back from the read
with var
! prepended.
!
IMPLICIT NONE
CHARACTER(len=10) :: var = "hello"
character(len=10) :: a = ""
NAMELIST /inx/ var
OPEN(unit=11, status='scratch')
write (11, *) "&INX"
write (11, *) " var = 'goodbye'"
write (11, *) "&END"
rewind (11)
READ(11,NML=inx)
CLOSE(11)
OPEN(unit=11, status='scratch')
write (11, *) "alls_well"
rewind (11)
READ(11,*) a
CLOSE(11)
if (a /= "alls_well") call abort ()
END