backport: re PR fortran/59700 (Misleading/buggy runtime error message: Bad integer...

2014-02-21  Jerry DeLisle  <jvdelisle@gcc.gnu>
	    Dominique d'Humieres  <dominiq@lps.ens.fr>
	    Steven G. Kargl  <kargl@gcc.gnu.org>

	Backport from mainline
	PR libfortran/59700
	PR libfortran/59764
	* io/io.h (struct st_parameter_dt): Assign expanded_read flag to
	unused bit. Define new variable line_buffer_pos.
	* io/list_read.c (free_saved, next_char, l_push_char,
	read_logical, read_real): Replace use of item_count with
	line_buffer_pos for line_buffer look ahead.
	(read_logical, read_integer, parse_real, read_real, check_type):
	Adjust location of free_line to after generating error messages
	to retain the correct item count for the message.

Co-Authored-By: Dominique d'Humieres <dominiq@lps.ens.fr>
Co-Authored-By: Steven G. Kargl <kargl@gcc.gnu.org>
From-SVN: r208038

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 38440d2aa9d328b24e3f5e749d5f2013de1ff190..fa07295f6ed488372e4b7a16065e9b4ece1a7e35 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,19 @@
+2014-02-21  Jerry DeLisle  <jvdelisle@gcc.gnu>
+           Dominique d'Humieres  <dominiq@lps.ens.fr>
+           Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from mainline
+       PR libfortran/59700
+       PR libfortran/59764
+       * io/io.h (struct st_parameter_dt): Assign expanded_read flag to
+       unused bit. Define new variable line_buffer_pos.
+       * io/list_read.c (free_saved, next_char, l_push_char,
+       read_logical, read_real): Replace use of item_count with
+       line_buffer_pos for line_buffer look ahead.
+       (read_logical, read_integer, parse_real, read_real, check_type):
+       Adjust location of free_line to after generating error messages
+       to retain the correct item count for the message. 
+
 2014-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu>
            Dominique d'Humieres  <dominiq@lps.ens.fr>
 

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 8ea9326670b5aaeb24f24b5f34f39daca4c61f1f..10f09855f1f8f6388033bdae495f7ab3d3f24ad5 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -424,7 +424,10 @@ typedef struct st_parameter_dt
          unsigned g0_no_blanks : 1;
          /* Used to signal use of free_format_data.  */
          unsigned format_not_saved : 1;
-         /* 14 unused bits.  */
+         /* A flag used to identify when a non-standard expanded namelist read
+            has occurred.  */
+         unsigned expanded_read : 1;
+         /* 13 unused bits.  */
 
          /* Used for ungetc() style functionality. Possible values
             are an unsigned char, EOF, or EOF - 1 used to mark the
@@ -441,9 +444,8 @@ typedef struct st_parameter_dt
          char *line_buffer;
          struct format_data *fmt;
          namelist_info *ionml;
-         /* A flag used to identify when a non-standard expanded namelist read
-            has occurred.  */
-         int expanded_read;
+         /* Current position within the look-ahead line buffer.  */
+         int line_buffer_pos;
          /* Storage area for values except for strings.  Must be
             large enough to hold a complex value (two reals) of the
             largest kind.  */

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 60f4549cd204753d28b6dd958501522ed6f63fe1..7cafad0c55d551c7efd224832904a63df3848bfe 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -118,7 +118,7 @@ free_saved (st_parameter_dt *dtp)
 static void
 free_line (st_parameter_dt *dtp)
 {
-  dtp->u.p.item_count = 0;
+  dtp->u.p.line_buffer_pos = 0;
   dtp->u.p.line_buffer_enabled = 0;
 
   if (dtp->u.p.line_buffer == NULL)
@@ -150,15 +150,15 @@ next_char (st_parameter_dt *dtp)
     {
       dtp->u.p.at_eol = 0;
 
-      c = dtp->u.p.line_buffer[dtp->u.p.item_count];
-      if (c != '\0' && dtp->u.p.item_count < 64)
+      c = dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos];
+      if (c != '\0' && dtp->u.p.line_buffer_pos < 64)
        {
-         dtp->u.p.line_buffer[dtp->u.p.item_count] = '\0';
-         dtp->u.p.item_count++;
+         dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos] = '\0';
+         dtp->u.p.line_buffer_pos++;
          goto done;
        }
 
-      dtp->u.p.item_count = 0;
+      dtp->u.p.line_buffer_pos = 0;
       dtp->u.p.line_buffer_enabled = 0;
     }    
 
@@ -640,7 +640,7 @@ l_push_char (st_parameter_dt *dtp, char c)
   if (dtp->u.p.line_buffer == NULL)
     dtp->u.p.line_buffer = xcalloc (SCRATCH_SIZE, 1);
 
-  dtp->u.p.line_buffer[dtp->u.p.item_count++] = c;
+  dtp->u.p.line_buffer[dtp->u.p.line_buffer_pos++] = c;
 }
 
 
@@ -750,7 +750,7 @@ read_logical (st_parameter_dt *dtp, int length)
        {
          dtp->u.p.nml_read_error = 1;
          dtp->u.p.line_buffer_enabled = 1;
-         dtp->u.p.item_count = 0;
+         dtp->u.p.line_buffer_pos = 0;
          return;
        }
       
@@ -758,14 +758,17 @@ read_logical (st_parameter_dt *dtp, int length)
 
  bad_logical:
 
-  free_line (dtp);
-
   if (nml_bad_return (dtp, c))
-    return;
+    {
+      free_line (dtp);
+      return;
+    }
+
 
   free_saved (dtp);
   if (c == EOF)
     {
+      free_line (dtp);
       hit_eof (dtp);
       return;
     }
@@ -773,6 +776,7 @@ read_logical (st_parameter_dt *dtp, int length)
     eat_line (dtp);
   snprintf (message, MSGLEN, "Bad logical value while reading item %d",
              dtp->u.p.item_count);
+  free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
   return;
 
@@ -913,9 +917,9 @@ read_integer (st_parameter_dt *dtp, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  free_line (dtp);
   snprintf (message, MSGLEN, "Bad integer for item %d in list input",
              dtp->u.p.item_count);
+  free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 
   return;
@@ -1298,9 +1302,9 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  free_line (dtp);
   snprintf (message, MSGLEN, "Bad floating point number for item %d",
              dtp->u.p.item_count);
+  free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 
   return 1;
@@ -1406,9 +1410,9 @@ eol_4:
   else if (c != '\n')   
     eat_line (dtp);
 
-  free_line (dtp);
   snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
              dtp->u.p.item_count);
+  free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 }
 
@@ -1770,7 +1774,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
     {
       dtp->u.p.nml_read_error = 1;
       dtp->u.p.line_buffer_enabled = 1;
-      dtp->u.p.item_count = 0;
+      dtp->u.p.line_buffer_pos = 0;
       return;
     }
 
@@ -1789,9 +1793,9 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  free_line (dtp);
   snprintf (message, MSGLEN, "Bad real number in item %d of list input",
              dtp->u.p.item_count);
+  free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 }
 
@@ -1806,11 +1810,10 @@ check_type (st_parameter_dt *dtp, bt type, int len)
 
   if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
     {
-      free_line (dtp);
       snprintf (message, MSGLEN, "Read type %s where %s was expected for item %d",
                  type_name (dtp->u.p.saved_type), type_name (type),
                  dtp->u.p.item_count);
-
+      free_line (dtp);
       generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
       return 1;
     }
@@ -1820,12 +1823,12 @@ check_type (st_parameter_dt *dtp, bt type, int len)
 
   if (dtp->u.p.saved_length != len)
     {
-      free_line (dtp);
       snprintf (message, MSGLEN,
                  "Read kind %d %s where kind %d is required for item %d",
                  dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len,
                  dtp->u.p.item_count);
       generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
+      free_line (dtp);
       return 1;
     }