From 64a454d9f74cecd95241e96fef281b64715049c4 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Tue, 23 Feb 2016 18:38:31 +0000 Subject: [PATCH] re PR fortran/69456 (Namelist value with trailing sign is ignored without error) 2016-02-23 Jerry DeLisle 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 | 6 ++++ gcc/testsuite/gfortran.dg/namelist_89.f90 | 47 +++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr59700.f90 | 2 +- libgfortran/ChangeLog | 9 ++++++ libgfortran/io/list_read.c | 14 ++++++--- 5 files changed, 73 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/namelist_89.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9fa77b1c47a..4b8cb0193a0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-02-23 Jerry DeLisle + + PR libgfortran/69456 + * gfortran.dg/namelist_89.f90: New test. + * gfortran.dg/pr59700.f90: Update test.. + 2016-02-23 Martin Sebor PR middle-end/69780 diff --git a/gcc/testsuite/gfortran.dg/namelist_89.f90 b/gcc/testsuite/gfortran.dg/namelist_89.f90 new file mode 100644 index 00000000000..cfae4664d62 --- /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+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 diff --git a/gcc/testsuite/gfortran.dg/pr59700.f90 b/gcc/testsuite/gfortran.dg/pr59700.f90 index 579d8a48c9a..15bf26129ab 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/ChangeLog b/libgfortran/ChangeLog index 436b598443a..4d10b2779e4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,12 @@ +2016-02-23 Jerry DeLisle + + 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 PR libgfortran/69651 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index bebdd8cf301..e24b3922631 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); -- 2.11.4.GIT