diff mbox

[Fortran] PR56735 - Fix namelist read regression with "?"

Message ID 51544A2B.2010608@net-b.de
State New
Headers show

Commit Message

Tobias Burnus March 28, 2013, 1:48 p.m. UTC 
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

Comments

Jerry DeLisle March 29, 2013, 1:31 a.m. UTC | #1 
On 03/28/2013 06:48 AM, Tobias Burnus wrote:
> 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

Yes OK.  Please test on the backports and allow it to settle on trunk for a bit
before the backport.

Jerry
diff mbox

Patch

2013-03-28  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  Tobias Burnus  <burnus@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;