mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 05:20:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR libfortran/34427 (Revision 130708 breaks namelist input)

Browse Source 
2007-12-13  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34427
        * io/list_read.c (read_real): Fix unwinding for namelists.

2007-12-13  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34427
        * gfortran.dg/namelist_42.f90: New.

From-SVN: r130889
This commit is contained in:
Tobias Burnus 2007-12-13 12:01:00 +01:00 committed by Tobias Burnus
parent 014c009534
commit b446725a8a
4 changed files with 134 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-13 Tobias Burnus <burnus@net-b.de>
PR fortran/34427
* gfortran.dg/namelist_42.f90: New.
2007-12-12 Tobias Burnus <burnus@net-b.de>
PR fortran/34254

34
gcc/testsuite/gfortran.dg/namelist_42.f90 Normal file
View File

@ -0,0 +1,34 @@
! { dg-do run }
! { dg-options "-mieee" { target sh*-*-* } }
!
! PR fortran/34427
!
! Check that namelists and the real values Inf, NaN, Infinity
! properly coexist.
!
PROGRAM TEST
IMPLICIT NONE
real , DIMENSION(11) ::foo
integer :: infinity
NAMELIST /nl/ foo
NAMELIST /nl/ infinity
foo = -1.0
infinity = -1
open (10, status="scratch")
! Works:
write (10,*) " &nl foo = 5, 5, 5, nan, infinity, infinity "
write (10,*)
write (10,*) " = 1, /"
! Does not work
!write (10,*) " &nl foo = 5, 5, 5, nan, infinity, infinity"
!write (10,*) " = 1, /"
rewind (10)
READ (10, NML = nl)
CLOSE (10)
if(infinity /= 1) call abort()
if(any(foo(1:3) /= [5.0, 5.0, 5.0]) .or. .not.isnan(foo(4)) &
.or. foo(5) <= huge(foo) .or. any(foo(6:11) /= -1.0)) &
call abort()
END PROGRAM TEST

5
libgfortran/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-13 Tobias Burnus <burnus@net-b.de>
PR fortran/34427
* io/list_read.c (read_real): Fix unwinding for namelists.
2007-12-10 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/34411

111
libgfortran/io/list_read.c
View File

@ -1315,6 +1315,7 @@ read_real (st_parameter_dt *dtp, int length)
{
char c, message[100];
int seen_dp;
int is_inf, i;
seen_dp = 0;
@ -1522,34 +1523,102 @@ read_real (st_parameter_dt *dtp, int length)
return;
inf_nan:
l_push_char (dtp, c);
is_inf = 0;
/* Match INF and Infinity. */
if ((c == 'i' || c == 'I')
&& ((c = next_char (dtp)) == 'n' || c == 'N')
&& ((c = next_char (dtp)) == 'f' || c == 'F'))
if (c == 'i' || c == 'I')
{
c = next_char (dtp);
if (is_separator (c)
|| ((c == 'i' || c == 'I')
&& ((c = next_char (dtp)) == 'n' || c == 'N')
&& ((c = next_char (dtp)) == 'i' || c == 'I')
&& ((c = next_char (dtp)) == 't' || c == 'T')
&& ((c = next_char (dtp)) == 'y' || c == 'Y')
&& (c = next_char (dtp)) && is_separator (c)))
{
push_char (dtp, 'i');
push_char (dtp, 'n');
push_char (dtp, 'f');
goto done;
}
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'n' && c != 'N')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'f' && c != 'F')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (!is_separator (c))
{
if (c != 'i' && c != 'I')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'n' && c != 'N')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'i' && c != 'I')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 't' && c != 'T')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'y' && c != 'Y')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
}
is_inf = 1;
} /* Match NaN. */
else if (((c = next_char (dtp)) == 'a' || c == 'A')
&& ((c = next_char (dtp)) == 'n' || c == 'N')
&& (c = next_char (dtp)) && is_separator (c))
else
{
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'a' && c != 'A')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
if (c != 'n' && c != 'N')
goto unwind;
c = next_char (dtp);
l_push_char (dtp, c);
}
if (!is_separator (c) || c == '=')
goto unwind;
if (dtp->u.p.namelist_mode && c != ',' && c != '/')
for (i = 0; i < 63; i++)
{
eat_spaces (dtp);
c = next_char (dtp);
l_push_char (dtp, c);
if (c == '=')
goto unwind;
if (c == ',' || c == '/' || !is_separator(c))
break;
}
if (is_inf)
{
push_char (dtp, 'i');
push_char (dtp, 'n');
push_char (dtp, 'f');
}
else
{
push_char (dtp, 'n');
push_char (dtp, 'a');
push_char (dtp, 'n');
goto done;
}
dtp->u.p.item_count = 0;
dtp->u.p.line_buffer_enabled = 0;
free_line (dtp);
goto done;
unwind:
if (dtp->u.p.namelist_mode)
{
dtp->u.p.nml_read_error = 1;
dtp->u.p.line_buffer_enabled = 1;
dtp->u.p.item_count = 0;
return;
}
bad_real: