:ADDPATCH fortran:
Attached is a revised patch to replace my previous submittal. This
patch incorporates memory allocation using the line_buffer pointer in
st_parameter_dt so that variable names up to 63 characters long can be
evaluated during logical namelist reads.
This patch also addresses comments by HJ Lu in the PR, fixing an
omission I made.
Revised expanded testcase attached as well.
Regression tested.
OK for Trunk and 4.1 after freeze?
Regards,
Jerry
2006-02-19 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.
------------------------------------------------------------------------
Index: io/list_read.c
===================================================================
*** io/list_read.c (revision 111172)
--- io/list_read.c (working copy)
*************** free_saved (st_parameter_dt *dtp)
*** 117,122 ****
--- 117,135 ----
}
+ /* 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)
{
*************** next_char (st_parameter_dt *dtp)
*** 132,138 ****
goto done;
}
! length = 1;
/* Handle the end-of-record condition for internal array unit */
if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0)
--- 145,167 ----
goto done;
}
! /* 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)
*************** next_char (st_parameter_dt *dtp)
*** 154,159 ****
--- 183,191 ----
}
/* 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))
*************** parse_repeat (st_parameter_dt *dtp)
*** 510,552 ****
}
/* Read a logical character on the input. */
static void
read_logical (st_parameter_dt *dtp, int length)
{
char c, message[100];
! int v;
if (parse_repeat (dtp))
return;
! c = next_char (dtp);
switch (c)
{
case 't':
- case 'T':
v = 1;
break;
case 'f':
- case 'F':
v = 0;
! break;
case '.':
! c = next_char (dtp);
switch (c)
{
! case 't':
! case 'T':
! v = 1;
! break;
! case 'f':
! case 'F':
! v = 0;
! break;
! default:
! goto bad_logical;
}
break;
--- 542,614 ----
}
+ /* 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 i, v;
if (parse_repeat (dtp))
return;
! c = tolower (next_char (dtp));
! l_push_char (dtp, c);
switch (c)
{
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':
v = 0;
! c = next_char (dtp);
! l_push_char (dtp, c);
+ if (!is_separator(c))
+ goto possible_name;
+
+ unget_char (dtp, c);
+ break;
case '.':
! c = tolower (next_char (dtp));
switch (c)
{
! case 't':
! v = 1;
! break;
! case 'f':
! v = 0;
! break;
! default:
! goto bad_logical;
}
break;
*************** read_logical (st_parameter_dt *dtp, int
*** 572,582 ****
unget_char (dtp, c);
eat_separator (dtp);
! free_saved (dtp);
set_integer ((int *) dtp->u.p.value, v, length);
return;
bad_logical:
if (nml_bad_return (dtp, c))
--- 634,677 ----
unget_char (dtp, c);
eat_separator (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))
*************** find_nml_name:
*** 2435,2440 ****
--- 2530,2536 ----
dtp->u.p.eof_jump = NULL;
free_saved (dtp);
+ free_line (dtp);
return;
/* All namelist error calls return from here */
*************** nml_err_ret:
*** 2443,2448 ****
--- 2539,2545 ----
dtp->u.p.eof_jump = NULL;
free_saved (dtp);
+ free_line (dtp);
generate_error (&dtp->common, ERROR_READ_VALUE, nml_err_msg);
return;
}
Index: io/io.h
===================================================================
*** io/io.h (revision 111172)
--- io/io.h (working copy)
***************
*** 1,4 ****
! /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
--- 1,4 ----
! /* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
*************** typedef struct st_parameter_dt
*** 371,377 ****
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. */
unit_mode mode;
unit_blank blank_status;
enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
--- 371,379 ----
void (*transfer) (struct st_parameter_dt *, bt, void *, int,
size_t, size_t);
struct gfc_unit *current_unit;
! /* 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;
*************** typedef struct st_parameter_dt
*** 409,415 ****
character string is being read so don't use commas to shorten a
formatted field width. */
unsigned sf_read_comma : 1;
! /* 19 unused bits. */
char last_char;
char nml_delim;
--- 411,420 ----
character string is being read so don't use commas to shorten a
formatted field width. */
unsigned sf_read_comma : 1;
! /* 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;