re PR fortran/69456 (Namelist value with trailing sign is ignored without error)

2016-02-23  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.

	PR libgfortran/69456
	* gfortran.dg/namelist_89.f90: New test.
	* gfortran.dg/pr59700.f90: Update test..

From-SVN: r233641

gcc/testsuite/ChangeLog

+2016-02-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/69456
+	* gfortran.dg/namelist_89.f90: New test.
+	* gfortran.dg/pr59700.f90: Update test..
+
 2016-02-23  Martin Sebor  <msebor@redhat.com>
 
 	PR middle-end/69780

gcc/testsuite/gfortran.dg/namelist_89.f90

+! { 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+1)" ! Treated as (1e-1,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

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

libgfortran/ChangeLog

+2016-02-23  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.
+
 2016-02-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/69651

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);