From 3fce2120c49315520b3703023aa13790d9906890 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 13 Dec 2007 11:01:00 +0000 Subject: 2007-12-13 Tobias Burnus PR fortran/34427 * io/list_read.c (read_real): Fix unwinding for namelists. 2007-12-13 Tobias Burnus PR fortran/34427 * gfortran.dg/namelist_42.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130889 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/ChangeLog | 5 ++ libgfortran/io/list_read.c | 111 ++++++++++++++++++++++++++++++++++++--------- 2 files changed, 95 insertions(+), 21 deletions(-) (limited to 'libgfortran') diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e23d362a89c..12969af81d8 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 9ac5609e9ce..e63fca57a2f 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: -- cgit v1.2.1