diff options
-rw-r--r-- | libgfortran/ChangeLog | 12 | ||||
-rw-r--r-- | libgfortran/io/io.h | 9 | ||||
-rw-r--r-- | libgfortran/io/list_read.c | 133 |
3 files changed, 134 insertions, 20 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 136e85090c2..39039a66e9b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2006-02-28 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/26136 + * io/io.h: Add flag for reading from line_buffer. + * io/list_read.c (l_push_char): New function to save namelist + input when reading logicals. + (free_line): New function to free line_buffer memory. + (next_char): Added feature to read from line_buffer. + (read_logical): Use new functions to test for '=' after reading a + logical value, checking for possible variable name. + (namelist_read): Use free_line when all done. + 2006-02-27 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/26464 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 9b35ef91650..e36debbbaee 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -371,7 +371,9 @@ typedef struct st_parameter_dt void (*transfer) (struct st_parameter_dt *, bt, void *, int, size_t, size_t); struct gfc_unit *current_unit; - int item_count; /* Item number in a formatted data transfer. */ + /* Item number in a formatted data transfer. Also used in namelist + read_logical as an index into line_buffer. */ + int item_count; unit_mode mode; unit_blank blank_status; enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status; @@ -409,7 +411,10 @@ typedef struct st_parameter_dt character string is being read so don't use commas to shorten a formatted field width. */ unsigned sf_read_comma : 1; - /* 19 unused bits. */ + /* A namelist specific flag used to enable reading input from + line_buffer for logical reads. */ + unsigned line_buffer_enabled : 1; + /* 18 unused bits. */ char last_char; char nml_delim; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 793f0e25d41..5ff4cbbc299 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -117,6 +117,19 @@ free_saved (st_parameter_dt *dtp) } +/* Free the line buffer if necessary. */ + +static void +free_line (st_parameter_dt *dtp) +{ + if (dtp->u.p.line_buffer == NULL) + return; + + free_mem (dtp->u.p.line_buffer); + dtp->u.p.line_buffer = NULL; +} + + static char next_char (st_parameter_dt *dtp) { @@ -132,7 +145,23 @@ next_char (st_parameter_dt *dtp) goto done; } - length = 1; + /* Read from line_buffer if enabled. */ + + if (dtp->u.p.line_buffer_enabled) + { + dtp->u.p.at_eol = 0; + + c = dtp->u.p.line_buffer[dtp->u.p.item_count]; + if (c != '\0' && dtp->u.p.item_count < 64) + { + dtp->u.p.line_buffer[dtp->u.p.item_count] = '\0'; + dtp->u.p.item_count++; + goto done; + } + + dtp->u.p.item_count = 0; + dtp->u.p.line_buffer_enabled = 0; + } /* Handle the end-of-record condition for internal array unit */ if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0) @@ -154,6 +183,9 @@ next_char (st_parameter_dt *dtp) } /* Get the next character and handle end-of-record conditions */ + + length = 1; + p = salloc_r (dtp->u.p.current_unit->s, &length); if (is_internal_unit(dtp)) @@ -510,43 +542,73 @@ parse_repeat (st_parameter_dt *dtp) } +/* To read a logical we have to look ahead in the input stream to make sure + there is not an equal sign indicating a variable name. To do this we use + line_buffer to point to a temporary buffer, pushing characters there for + possible later reading. */ + +static void +l_push_char (st_parameter_dt *dtp, char c) +{ + char *new; + + if (dtp->u.p.line_buffer == NULL) + { + dtp->u.p.line_buffer = get_mem (SCRATCH_SIZE); + memset (dtp->u.p.line_buffer, 0, SCRATCH_SIZE); + } + + dtp->u.p.line_buffer[dtp->u.p.item_count++] = c; +} + + /* Read a logical character on the input. */ static void read_logical (st_parameter_dt *dtp, int length) { char c, message[100]; - int v; + int i, v; if (parse_repeat (dtp)) return; - c = next_char (dtp); + c = tolower (next_char (dtp)); + l_push_char (dtp, c); switch (c) { case 't': - case 'T': v = 1; + c = next_char (dtp); + l_push_char (dtp, c); + + if (!is_separator(c)) + goto possible_name; + + unget_char (dtp, c); break; case 'f': - case 'F': v = 0; - break; + c = next_char (dtp); + l_push_char (dtp, c); + if (!is_separator(c)) + goto possible_name; + + unget_char (dtp, c); + break; case '.': - c = next_char (dtp); + c = tolower (next_char (dtp)); switch (c) { - case 't': - case 'T': - v = 1; - break; - case 'f': - case 'F': - v = 0; - break; - default: - goto bad_logical; + case 't': + v = 1; + break; + case 'f': + v = 0; + break; + default: + goto bad_logical; } break; @@ -572,11 +634,44 @@ read_logical (st_parameter_dt *dtp, int length) unget_char (dtp, c); eat_separator (dtp); - free_saved (dtp); + dtp->u.p.item_count = 0; + dtp->u.p.line_buffer_enabled = 0; set_integer ((int *) dtp->u.p.value, v, length); return; + possible_name: + + for(i = 0; i < 63; i++) + { + c = next_char (dtp); + if (is_separator(c)) + { + unget_char (dtp, c); + eat_separator (dtp); + c = next_char (dtp); + if (c != '=') + { + unget_char (dtp, c); + dtp->u.p.item_count = 0; + dtp->u.p.line_buffer_enabled = 0; + dtp->u.p.saved_type = BT_LOGICAL; + dtp->u.p.saved_length = length; + set_integer ((int *) dtp->u.p.value, v, length); + return; + } + } + + l_push_char (dtp, c); + if (c == '=') + { + dtp->u.p.nml_read_error = 1; + dtp->u.p.line_buffer_enabled = 1; + dtp->u.p.item_count = 0; + return; + } + } + bad_logical: if (nml_bad_return (dtp, c)) @@ -2435,6 +2530,7 @@ find_nml_name: dtp->u.p.eof_jump = NULL; free_saved (dtp); + free_line (dtp); return; /* All namelist error calls return from here */ @@ -2443,6 +2539,7 @@ nml_err_ret: dtp->u.p.eof_jump = NULL; free_saved (dtp); + free_line (dtp); generate_error (&dtp->common, ERROR_READ_VALUE, nml_err_msg); return; } |