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

        Backport from mainline:
        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-04-03  Tobias Burnus  <burnus@net-b.de>

        Backport from mainline:
        2013-03-28  Tobias Burnus  <burnus@net-b.de>

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@197396 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a7ec289..a7e62e4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2013-04-03  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline:
+       2013-03-28  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/56735
+       * gfortran.dg/namelist_80.f90: New.
+

 2013-04-03  Jakub Jelinek  <jakub@redhat.com>
 
        Backported from mainline
 2013-04-03  Jakub Jelinek  <jakub@redhat.com>
 
        Backported from mainline

diff --git a/gcc/testsuite/gfortran.dg/namelist_80.f90 b/gcc/testsuite/gfortran.dg/namelist_80.f90
new file mode 100644 (file)
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/ChangeLog b/libgfortran/ChangeLog
index b7ba52e..24efe98 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2013-04-03  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline:
+       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-02-21  Janne Blomqvist  <jb@gcc.gnu.org>
 
        PR libfortran/30162
 2013-02-21  Janne Blomqvist  <jb@gcc.gnu.org>
 
        PR libfortran/30162


@@ -34,9 +44,9 @@
 
 2012-05-31  Benjamin Kosnik  <bkoz@redhat.com>
 
 
 2012-05-31  Benjamin Kosnik  <bkoz@redhat.com>
 

-        PR libstdc++/52007
-        * configure.ac: Allow gnu, gnu* variants for --enable-symvers argument.
-        * configure: Regenerated.
+       PR libstdc++/52007
+       * configure.ac: Allow gnu, gnu* variants for --enable-symvers argument.
+       * configure: Regenerated.

 
 2012-05-12  Tobias Burnus  <burnus@net-b.de>
 
 
 2012-05-12  Tobias Burnus  <burnus@net-b.de>
 

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 11a35c9..efb43f8 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2355,11 +2355,11 @@ nml_query (st_parameter_dt *dtp, char c)
   index_type len;
   char * p;
 #ifdef HAVE_CRLF
   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 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
   static const char endl[] = "\n";
   static const char nmlend[] = "&end\n";
 #endif


@@ -2389,12 +2389,12 @@ nml_query (st_parameter_dt *dtp, char c)
          /* "&namelist_name\n"  */
 
          len = dtp->namelist_name_len;
          /* "&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);
           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"  */
          for (nl = dtp->u.p.ionml; nl; nl = nl->next)
            {
              /* " var_name\n"  */


@@ -2405,14 +2405,15 @@ nml_query (st_parameter_dt *dtp, char c)
                goto query_return;
              memcpy (p, " ", 1);
              memcpy ((char*)(p + 1), nl->var_name, len);
                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"  */
 
            }
 
          /* "&end\n"  */
 

-          p = write_block (dtp, endlen + 3);
+          p = write_block (dtp, endlen + 4);
+         if (!p)

            goto query_return;
            goto query_return;

-          memcpy (p, &nmlend, endlen + 3);
+          memcpy (p, &nmlend, endlen + 4);

        }
 
       /* Flush the stream to force immediate output.  */
        }
 
       /* Flush the stream to force immediate output.  */


@@ -3047,6 +3048,7 @@ find_nml_name:
 
     case '?':
       nml_query (dtp, '?');
 
     case '?':
       nml_query (dtp, '?');

+      goto find_nml_name;

 
     case EOF:
       return;
 
     case EOF:
       return;