procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/26136 (List directed input with underfilled (logicals) array read incorrectly)

Browse source 
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.

From-SVN: r111597
This commit is contained in:
Jerry DeLisle 2006-03-01 06:04:45 +00:00
parent ec09c26e3a
commit c9f15d9c0e
3 changed files with 135 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
libgfortran/ChangeLog
View file

@ -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

9
libgfortran/io/io.h
View file

@ -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;

135
libgfortran/io/list_read.c
View file

@ -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;
case '.':
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':
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;
}