diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 78f1b06a40a7..d665f7dbcf76 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-12-13 Tobias Burnus + + PR fortran/34427 + * gfortran.dg/namelist_42.f90: New. + 2007-12-12 Tobias Burnus PR fortran/34254 diff --git a/gcc/testsuite/gfortran.dg/namelist_42.f90 b/gcc/testsuite/gfortran.dg/namelist_42.f90 new file mode 100644 index 000000000000..b0095fe0e6a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_42.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e23d362a89c2..12969af81d8c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,8 @@ +2007-12-13 Tobias Burnus + + PR fortran/34427 + * io/list_read.c (read_real): Fix unwinding for namelists. + 2007-12-10 Jerry DeLisle PR libfortran/34411 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 9ac5609e9ce2..e63fca57a2f2 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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: