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
This commit is contained in:
Jerry DeLisle 2016-02-23 18:38:31 +00:00
parent 35886f0bd4
commit 64a454d9f7
5 changed files with 73 additions and 5 deletions

View File

@ -1,3 +1,9 @@
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

View File

@ -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+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

View File

@ -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

View File

@ -1,3 +1,12 @@
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

View File

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