summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libgfortran/ChangeLog12
-rw-r--r--libgfortran/io/io.h9
-rw-r--r--libgfortran/io/list_read.c133
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;
}