diff mbox

[libgfortran] PR69456 Namelist value with trailing sign is ignored without error

Message ID 56CB8165.7070002@charter.net
State New
Headers show

Commit Message

Jerry DeLisle Feb. 22, 2016, 9:45 p.m. UTC 
Hi all,

The problem here is we were treating a bad exponent as if it was a bad read.  On
bad reads we take a soft error path and go back to see if we are reading a new
namelist name. It is done this way because short reads, for example, part of an
array, are permitted. To get to the code where the error occurs, we have to have
read an exponent sign or a valid number with an exponent letter. In this case it
is not likely that we are reading a namelist name.

So, the patch takes the hard error path for a bad exponent so that we get a real
error.

I also noticed the error messages were not giving the correct item number
(always zero) so I realized the item_count was not being incremented for each
object. So fixed this as well.

Regression tested on x86-64-Linux. One new test case and one modified.

OK for trunk?  Not strictly a regression, but simple enough.

Jerry

2016-02-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/69456
	* io/list_read.c (read_real): If digit is missing from exponent issue
	an error. (parse_real): Likewise and adjusted error message to clarify
	it is part of a complex number.
	(nml_read_obj): Bump item count and add comment that this is used to
	identify which item in a namelist read has a problem.
diff mbox

Patch

diff --git a/gcc/testsuite/gfortran.dg/namelist_89.f90 b/gcc/testsuite/gfortran.dg/namelist_89.f90
new file mode 100644
index 0000000..aa086ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_89.f90
@@ -0,0 +1,47 @@ 
+! { dg-do run }
+! PR69456 Namelist value with trailing sign is ignored without error
+implicit none
+integer :: ios
+character(256) :: errormsg
+real :: r1 = -1
+real :: r2 = -1
+real :: r3 = -1
+real :: r4 = -1
+complex :: c1 = (-1,-1)
+namelist /nml/ r1, r2, r3, r4, c1
+
+open (99, status="scratch")
+
+write(99,*) "&nml"
+write(99,*) "  r1=1+1"      ! Treated as 1e+1?!
+write(99,*) "  r2=1-1"      ! Treated as 1e-1?!
+write(99,*) "  r3=1+1"      ! Treated as 1e+1?!
+write(99,*) "  r4=1-1"      ! Treated as 1e-1?!
+write(99,*) "  c1=(1-,1+1)" ! Should give error on item number 5
+write(99,*) "/"
+
+rewind(99)
+
+read (99, nml=nml, iostat=ios, iomsg=errormsg)
+if (ios.ne.5010) call abort
+if (scan(errormsg, "5").ne.44) call abort
+
+rewind(99)
+
+write(99,*) "&nml"
+write(99,*) "  r1=1+1"      ! Treated as 1e+1?!
+write(99,*) "  r2=1-"       ! Should give error on item number 2
+write(99,*) "  r3=1+1"      ! Treated as 1e+1?!
+write(99,*) "  r4=1-1"      ! Treated as 1e-1?!
+write(99,*) "  c1=(1-,1+1)" ! Treated as 1e-1?!
+write(99,*) "/"
+
+rewind(99)
+
+read (99, nml=nml, iostat=ios, iomsg=errormsg)
+if (ios.ne.5010) call abort
+if (scan(errormsg, "2").ne.25) call abort
+
+close (99)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/pr59700.f90 b/gcc/testsuite/gfortran.dg/pr59700.f90
index 579d8a4..15bf261 100644
--- a/gcc/testsuite/gfortran.dg/pr59700.f90
+++ b/gcc/testsuite/gfortran.dg/pr59700.f90
@@ -35,6 +35,6 @@  program foo
    rewind(fd)
    msg = 'ok'
    read(fd, *, err=40, iomsg=msg) c1, c2
-40 if (msg /= 'Bad floating point number for item 2') call abort
+40 if (msg /= 'Bad complex floating point number for item 2') call abort
    close(fd)
 end program foo
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index bebdd8c..e24b392 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1374,7 +1374,7 @@  parse_real (st_parameter_dt *dtp, void *buffer, int length)
 
  exp2:
   if (!isdigit (c))
-    goto bad;
+    goto bad_exponent;
 
   push_char (dtp, c);
 
@@ -1472,6 +1472,8 @@  parse_real (st_parameter_dt *dtp, void *buffer, int length)
   if (nml_bad_return (dtp, c))
     return 0;
 
+ bad_exponent:
+
   free_saved (dtp);
   if (c == EOF)
     {
@@ -1482,8 +1484,8 @@  parse_real (st_parameter_dt *dtp, void *buffer, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad floating point number for item %d",
-	      dtp->u.p.item_count);
+  snprintf (message, MSGLEN, "Bad complex floating point "
+	    "number for item %d", dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
 
@@ -1814,7 +1816,8 @@  read_real (st_parameter_dt *dtp, void * dest, int length)
 
  exp2:
   if (!isdigit (c))
-    goto bad_real;
+    goto bad_exponent;
+
   push_char (dtp, c);
 
   for (;;)
@@ -1983,6 +1986,8 @@  read_real (st_parameter_dt *dtp, void * dest, int length)
   if (nml_bad_return (dtp, c))
     return;
 
+ bad_exponent:
+
   free_saved (dtp);
   if (c == EOF)
     {
@@ -2810,6 +2815,7 @@  nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
   if (dtp->u.p.nml_read_error || !nl->touched)
     return true;
 
+  dtp->u.p.item_count++;  /* Used in error messages.  */
   dtp->u.p.repeat_count = 0;
   eat_spaces (dtp);