gfortran supports "?" and "=?" as input with namelists (a somewhat
common vendor extension). Either of those can be used with stdin to
print the available fields of the namelist. With non-stdin input, the ?
and =? lines are simply ignored.
However, two patches, one in 2008 and one in 2011 broke that feature.
The first one broke the output of the namelist with stdin, the second
caused that the namelist read is aborted (with iostat == 0) - and the
namelist ist not read.
The attached patch fixes this. GCC 4.6 to 4.9 are affected by the latter
issue (for which the PR has been filled). The other issue affects 4.5 to
4.9 and only applies to stdin input, for which no output is shown when
using "?".
Build and regtested on x86-64-gnu-linux.
OK for the trunk - and for GCC 4.6 to 4.8?
Tobias
2013-03-28 Tobias Burnus <bur...@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 Tobias Burnus <bur...@net-b.de>
PR fortran/56735
* gfortran.dg/namelist_80.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/namelist_80.f90 b/gcc/testsuite/gfortran.dg/namelist_80.f90
new file mode 100644
index 0000000..1961b11
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_80.f90
@@ -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
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index ec45570..7ce727d 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -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;
