aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2013-03-29 10:32:57 +0100
committerTobias Burnus <burnus@gcc.gnu.org>2013-03-29 10:32:57 +0100
commita0b012be6aef65bd11107f8dac814c3ac36f95d0 (patch)
tree144e5c29743f918b8ac2ba5b1e090d4fd7bbb462
parent58a491895f4b9680e41185a655547042df1115ac (diff)
downloadgcc-a0b012be6aef65bd11107f8dac814c3ac36f95d0.zip
gcc-a0b012be6aef65bd11107f8dac814c3ac36f95d0.tar.gz
gcc-a0b012be6aef65bd11107f8dac814c3ac36f95d0.tar.bz2
re PR fortran/56735 (Namelist Read Error with question marks)
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
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/namelist_80.f9027
-rw-r--r--libgfortran/io/list_read.c16
4 files changed, 48 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f1f1765..8aa1c4b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a7ccaad..622e0ca 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
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;