procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/56735 (Namelist Read Error with question marks)

Browse source 
2013-03-29  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56735
        * io/list_read.c (nml_query): Only abort when
        an error occured.
        (namelist_read): Add goto instead of falling through.

2013-03-29  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56735
        * gfortran.dg/namelist_80.f90: New.

From-SVN: r197228
This commit is contained in:
Tobias Burnus 2013-03-29 10:32:57 +01:00 • committed by Tobias Burnus
parent 58a491895f
commit a0b012be6a
4 changed files with 48 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56735
* io/list_read.c (nml_query): Only abort when
an error occured.
(namelist_read): Add goto instead of falling through.
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56735
* gfortran.dg/namelist_80.f90: New.
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159

27
gcc/testsuite/gfortran.dg/namelist_80.f90 Normal file
View file

@ -0,0 +1,27 @@
! { dg-do run }
!
! PR fortran/56735
!
! Contributed by Adam Williams
!
PROGRAM TEST
INTEGER int1,int2,int3
NAMELIST /temp/ int1,int2,int3
int1 = -1; int2 = -2; int3 = -3
OPEN (53, STATUS='scratch')
WRITE (53, '(a)') ' ?'
WRITE (53, '(a)')
WRITE (53, '(a)') '$temp'
WRITE (53, '(a)') ' int1=1'
WRITE (53, '(a)') ' int2=2'
WRITE (53, '(a)') ' int3=3'
WRITE (53, '(a)') '$END'
REWIND(53)
READ (53, temp)
CLOSE (53)
if (int1 /= 1 .or. int2 /= 2 .or. int3 /= 3) call abort()
END PROGRAM

16
libgfortran/io/list_read.c
View file

@ -2380,11 +2380,11 @@ nml_query (st_parameter_dt *dtp, char c)
index_type len;
char * p;
#ifdef HAVE_CRLF
static const index_type endlen = 3;
static const index_type endlen = 2;
static const char endl[] = "\r\n";
static const char nmlend[] = "&end\r\n";
#else
static const index_type endlen = 2;
static const index_type endlen = 1;
static const char endl[] = "\n";
static const char nmlend[] = "&end\n";
#endif
@ -2414,12 +2414,12 @@ nml_query (st_parameter_dt *dtp, char c)
/* "&namelist_name\n" */
len = dtp->namelist_name_len;
p = write_block (dtp, len + endlen);
p = write_block (dtp, len - 1 + endlen);
if (!p)
goto query_return;
memcpy (p, "&", 1);
memcpy ((char*)(p + 1), dtp->namelist_name, len);
memcpy ((char*)(p + len + 1), &endl, endlen - 1);
memcpy ((char*)(p + len + 1), &endl, endlen);
for (nl = dtp->u.p.ionml; nl; nl = nl->next)
{
/* " var_name\n" */
@ -2430,14 +2430,15 @@ nml_query (st_parameter_dt *dtp, char c)
goto query_return;
memcpy (p, " ", 1);
memcpy ((char*)(p + 1), nl->var_name, len);
memcpy ((char*)(p + len + 1), &endl, endlen - 1);
memcpy ((char*)(p + len + 1), &endl, endlen);
}
/* "&end\n" */
p = write_block (dtp, endlen + 3);
p = write_block (dtp, endlen + 4);
if (!p)
goto query_return;
memcpy (p, &nmlend, endlen + 3);
memcpy (p, &nmlend, endlen + 4);
}
/* Flush the stream to force immediate output. */
@ -3072,6 +3073,7 @@ find_nml_name:
case '?':
nml_query (dtp, '?');
goto find_nml_name;
case EOF:
return;