OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
963ddbd50f
gcc/libgfortran/io/list_read.c
Bud Davis bb9db7b136 re PR libfortran/16080 (segmentation fault when reading empty string) 
2004-06-19  Bud Davis  <bdavis9659@comcast.net>

        PR gfortran/16080
        * io/list_read.c(set_value): fixed spelling.

From-SVN: r83389
2004-06-19 17:03:16 +00:00

1537 lines
26 KiB
C
Raw Blame History

/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Libgfortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#include "config.h"
#include <string.h>
#include <ctype.h>
#include "libgfortran.h"
#include "io.h"
/* List directed input. Several parsing subroutines are practically
* reimplemented from formatted input, the reason being that there are
* all kinds of small differences between formatted and list directed
* parsing. */
/* Subroutines for reading characters from the input. Because a
* repeat count is ambiguous with an integer, we have to read the
* whole digit string before seeing if there is a '*' which signals
* the repeat count. Since we can have a lot of potential leading
* zeros, we have to be able to back up by arbitrary amount. Because
* the input might not be seekable, we have to buffer the data
* ourselves. Data is buffered in scratch[] until it becomes too
* large, after which we start allocating memory on the heap. */
static int repeat_count, saved_length, saved_used, input_complete, at_eol;
static int comma_flag, namelist_mode;
static char last_char, *saved_string;
static bt saved_type;
/* Storage area for values except for strings. Must be large enough
* to hold a complex value (two reals) of the largest kind */
static char value[20];
#define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \
case '5': case '6': case '7': case '8': case '9'
#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t'
/* This macro assumes that we're operating on a variable */
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
|| c == '\t')
/* Maximum repeat count. Less than ten times the maximum signed int32. */
#define MAX_REPEAT 200000000
/* push_char()-- Save a character to a string buffer, enlarging it as
* necessary. */
static void
push_char (char c)
{
char *new;
if (saved_string == NULL)
{
saved_string = scratch;
memset (saved_string,0,SCRATCH_SIZE);
saved_length = SCRATCH_SIZE;
saved_used = 0;
}
if (saved_used >= saved_length)
{
saved_length = 2 * saved_length;
new = get_mem (2 * saved_length);
memset (new,0,2 * saved_length);
memcpy (new, saved_string, saved_used);
if (saved_string != scratch)
free_mem (saved_string);
saved_string = new;
}
saved_string[saved_used++] = c;
}
/* free_saved()-- Free the input buffer if necessary. */
static void
free_saved (void)
{
if (saved_string == NULL)
return;
if (saved_string != scratch)
free_mem (saved_string);
saved_string = NULL;
}
static char
next_char (void)
{
int length;
char c, *p;
if (last_char != '\0')
{
at_eol = 0;
c = last_char;
last_char = '\0';
goto done;
}
length = 1;
p = salloc_r (current_unit->s, &length);
if (p == NULL)
{
generate_error (ERROR_OS, NULL);
return '\0';
}
if (length == 0)
longjmp (g.eof_jump, 1);
c = *p;
done:
at_eol = (c == '\n');
return c;
}
/* unget_char()-- Push a character back onto the input */
static void
unget_char (char c)
{
last_char = c;
}
/* eat_spaces()-- Skip over spaces in the input. Returns the nonspace
* character that terminated the eating and also places it back on the
* input. */
static char
eat_spaces (void)
{
char c;
do
{
c = next_char ();
}
while (c == ' ' || c == '\t');
unget_char (c);
return c;
}
/* eat_separator()-- Skip over a separator. Technically, we don't
* always eat the whole separator. This is because if we've processed
* the last input item, then a separator is unnecessary. Plus the
* fact that operating systems usually deliver console input on a line
* basis.
*
* The upshot is that if we see a newline as part of reading a
* separator, we stop reading. If there are more input items, we
* continue reading the separator with finish_separator() which takes
* care of the fact that we may or may not have seen a comma as part
* of the separator. */
static void
eat_separator (void)
{
char c;
eat_spaces ();
comma_flag = 0;
c = next_char ();
switch (c)
{
case ',':
comma_flag = 1;
eat_spaces ();
break;
case '/':
input_complete = 1;
next_record (0);
break;
case '\n':
break;
case '!':
if (namelist_mode)
{ /* Eat a namelist comment */
do
c = next_char ();
while (c != '\n');
break;
}
/* Fall Through */
default:
unget_char (c);
break;
}
}
/* finish_separator()-- Finish processing a separator that was
* interrupted by a newline. If we're here, then another data item is
* present, so we finish what we started on the previous line. */
static void
finish_separator (void)
{
char c;
restart:
eat_spaces ();
c = next_char ();
switch (c)
{
case ',':
if (comma_flag)
unget_char (c);
else
{
c = eat_spaces ();
if (c == '\n')
goto restart;
}
break;
case '/':
input_complete = 1;
next_record (0);
break;
case '\n':
goto restart;
case '!':
if (namelist_mode)
{
do
c = next_char ();
while (c != '\n');
goto restart;
}
default:
unget_char (c);
break;
}
}
/* convert_integer()-- Convert an unsigned string to an integer. The
* length value is -1 if we are working on a repeat count. Returns
* nonzero if we have a range problem. As a side effect, frees the
* saved_string. */
static int
convert_integer (int length, int negative)
{
char c, *buffer, message[100];
int m;
int64_t v, max, max10;
buffer = saved_string;
v = 0;
max = (length == -1) ? MAX_REPEAT : max_value (length, 1);
max10 = max / 10;
for (;;)
{
c = *buffer++;
if (c == '\0')
break;
c -= '0';
if (v > max10)
goto overflow;
v = 10 * v;
if (v > max - c)
goto overflow;
v += c;
}
m = 0;
if (length != -1)
{
if (negative)
v = -v;
set_integer (value, v, length);
}
else
{
repeat_count = v;
if (repeat_count == 0)
{
st_sprintf (message, "Zero repeat count in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
m = 1;
}
}
free_saved ();
return m;
overflow:
if (length == -1)
st_sprintf (message, "Repeat count overflow in item %d of list input",
g.item_count);
else
st_sprintf (message, "Integer overflow while reading item %d",
g.item_count);
free_saved ();
generate_error (ERROR_READ_VALUE, message);
return 1;
}
/* parse_repeat()-- Parse a repeat count for logical and complex
* values which cannot begin with a digit. Returns nonzero if we are
* done, zero if we should continue on. */
static int
parse_repeat (void)
{
char c, message[100];
int repeat;
c = next_char ();
switch (c)
{
CASE_DIGITS:
repeat = c - '0';
break;
CASE_SEPARATORS:
unget_char (c);
eat_separator ();
return 1;
default:
unget_char (c);
return 0;
}
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
repeat = 10 * repeat + c - '0';
if (repeat > MAX_REPEAT)
{
st_sprintf (message,
"Repeat count overflow in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
break;
case '*':
if (repeat == 0)
{
st_sprintf (message,
"Zero repeat count in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
goto done;
default:
goto bad_repeat;
}
}
done:
repeat_count = repeat;
return 0;
bad_repeat:
st_sprintf (message, "Bad repeat count in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
/* read_logical()-- Read a logical character on the input */
static void
read_logical (int length)
{
char c, message[100];
int v;
if (parse_repeat ())
return;
c = next_char ();
switch (c)
{
case 't':
case 'T':
v = 1;
break;
case 'f':
case 'F':
v = 0;
break;
case '.':
c = next_char ();
switch (c)
{
case 't':
case 'T':
v = 1;
break;
case 'f':
case 'F':
v = 0;
break;
default:
goto bad_logical;
}
break;
CASE_SEPARATORS:
unget_char (c);
eat_separator ();
return; /* Null value */
default:
goto bad_logical;
}
saved_type = BT_LOGICAL;
saved_length = length;
/* Eat trailing garbage */
do
{
c = next_char ();
}
while (!is_separator (c));
unget_char (c);
eat_separator ();
free_saved ();
set_integer ((int *) value, v, length);
return;
bad_logical:
st_sprintf (message, "Bad logical value while reading item %d",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
}
/* read_integer()-- Reading integers is tricky because we can actually
* be reading a repeat count. We have to store the characters in a
* buffer because we could be reading an integer that is larger than the
* default int used for repeat counts. */
static void
read_integer (int length)
{
char c, message[100];
int negative;
negative = 0;
c = next_char ();
switch (c)
{
case '-':
negative = 1;
/* Fall through */
case '+':
c = next_char ();
goto get_integer;
CASE_SEPARATORS: /* Single null */
unget_char (c);
eat_separator ();
return;
CASE_DIGITS:
push_char (c);
break;
default:
goto bad_integer;
}
/* Take care of what may be a repeat count */
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
case '*':
push_char ('\0');
goto repeat;
CASE_SEPARATORS: /* Not a repeat count */
goto done;
default:
goto bad_integer;
}
}
repeat:
if (convert_integer (-1, 0))
return;
/* Get the real integer */
c = next_char ();
switch (c)
{
CASE_DIGITS:
break;
CASE_SEPARATORS:
unget_char (c);
eat_separator ();
return;
case '-':
negative = 1;
/* Fall through */
case '+':
c = next_char ();
break;
}
get_integer:
if (!isdigit (c))
goto bad_integer;
push_char (c);
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
goto done;
default:
goto bad_integer;
}
}
bad_integer:
free_saved ();
st_sprintf (message, "Bad integer for item %d in list input", g.item_count);
generate_error (ERROR_READ_VALUE, message);
return;
done:
unget_char (c);
eat_separator ();
push_char ('\0');
if (convert_integer (length, negative))
{
free_saved ();
return;
}
free_saved ();
saved_type = BT_INTEGER;
}
/* read_character()-- Read a character variable */
static void
read_character (int length)
{
char c, quote, message[100];
quote = ' '; /* Space means no quote character */
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
unget_char (c); /* NULL value */
eat_separator ();
return;
case '"':
case '\'':
quote = c;
goto get_string;
default:
push_char (c);
goto get_string;
}
/* Deal with a possible repeat count */
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
unget_char (c);
goto done; /* String was only digits! */
case '*':
push_char ('\0');
goto got_repeat;
default:
push_char (c);
goto get_string; /* Not a repeat count after all */
}
}
got_repeat:
if (convert_integer (-1, 0))
return;
/* Now get the real string */
c = next_char ();
switch (c)
{
CASE_SEPARATORS:
unget_char (c); /* repeated NULL values */
eat_separator ();
return;
case '"':
case '\'':
quote = c;
break;
default:
push_char (c);
break;
}
get_string:
for (;;)
{
c = next_char ();
switch (c)
{
case '"':
case '\'':
if (c != quote)
{
push_char (c);
break;
}
/* See if we have a doubled quote character or the end of the string */
c = next_char ();
if (c == quote)
{
push_char (quote);
break;
}
unget_char (c);
goto done;
CASE_SEPARATORS:
if (quote == ' ')
{
unget_char (c);
goto done;
}
if (c != '\n')
push_char (c);
break;
default:
push_char (c);
break;
}
}
/* At this point, we have to have a separator, or else the string is invalid */
done:
c = next_char ();
if (is_separator (c))
{
unget_char (c);
eat_separator ();
saved_type = BT_CHARACTER;
}
else
{
free_saved ();
st_sprintf (message, "Invalid string input in item %d", g.item_count);
generate_error (ERROR_READ_VALUE, message);
}
}
/* parse_real()-- Parse a component of a complex constant or a real
* number that we are sure is already there. This is a straight real
* number parser. */
static int
parse_real (void *buffer, int length)
{
char c, message[100];
int m, seen_dp;
c = next_char ();
if (c == '-' || c == '+')
{
push_char (c);
c = next_char ();
}
if (!isdigit (c) && c != '.')
goto bad;
push_char (c);
seen_dp = (c == '.') ? 1 : 0;
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
case '.':
if (seen_dp)
goto bad;
seen_dp = 1;
push_char (c);
break;
case 'e':
case 'E':
case 'd':
case 'D':
push_char ('e');
goto exp1;
case '-':
case '+':
push_char ('e');
push_char (c);
c = next_char ();
goto exp2;
CASE_SEPARATORS:
unget_char (c);
goto done;
default:
goto done;
}
}
exp1:
c = next_char ();
if (c != '-' && c != '+')
push_char ('+');
else
{
push_char (c);
c = next_char ();
}
exp2:
if (!isdigit (c))
goto bad;
push_char (c);
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
unget_char (c);
goto done;
default:
goto done;
}
}
done:
unget_char (c);
push_char ('\0');
m = convert_real (buffer, saved_string, length);
free_saved ();
return m;
bad:
free_saved ();
st_sprintf (message, "Bad floating point number for item %d", g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
/* read_complex()-- Reading a complex number is straightforward
* because we can tell what it is right away. */
static void
read_complex (int length)
{
char message[100];
char c;
if (parse_repeat ())
return;
c = next_char ();
switch (c)
{
case '(':
break;
CASE_SEPARATORS:
unget_char (c);
eat_separator ();
return;
default:
goto bad_complex;
}
eat_spaces ();
if (parse_real (value, length))
return;
eat_spaces ();
if (next_char () != ',')
goto bad_complex;
eat_spaces ();
if (parse_real (value + length, length))
return;
eat_spaces ();
if (next_char () != ')')
goto bad_complex;
c = next_char ();
if (!is_separator (c))
goto bad_complex;
unget_char (c);
eat_separator ();
free_saved ();
saved_type = BT_COMPLEX;
return;
bad_complex:
st_sprintf (message, "Bad complex value in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
}
/* read_real()-- Parse a real number with a possible repeat count. */
static void
read_real (int length)
{
char c, message[100];
int seen_dp;
seen_dp = 0;
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
case '.':
push_char (c);
seen_dp = 1;
break;
case '+':
case '-':
goto got_sign;
CASE_SEPARATORS:
unget_char (c); /* Single null */
eat_separator ();
return;
default:
goto bad_real;
}
/* Get the digit string that might be a repeat count */
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
case '.':
if (seen_dp)
goto bad_real;
seen_dp = 1;
push_char (c);
goto real_loop;
case 'E':
case 'e':
case 'D':
case 'd':
goto exp1;
case '+':
case '-':
push_char ('e');
push_char (c);
c = next_char ();
goto exp2;
case '*':
push_char ('\0');
goto got_repeat;
CASE_SEPARATORS:
if (c != '\n')
unget_char (c); /* Real number that is just a digit-string */
goto done;
default:
goto bad_real;
}
}
got_repeat:
if (convert_integer (-1, 0))
return;
/* Now get the number itself */
c = next_char ();
if (is_separator (c))
{ /* Repeated null value */
unget_char (c);
eat_separator ();
return;
}
if (c != '-' && c != '+')
push_char ('+');
else
{
got_sign:
push_char (c);
c = next_char ();
}
if (!isdigit (c) && c != '.')
goto bad_real;
if (c == '.')
{
if (seen_dp)
goto bad_real;
else
seen_dp = 1;
}
push_char (c);
real_loop:
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
goto done;
case '.':
if (seen_dp)
goto bad_real;
seen_dp = 1;
push_char (c);
break;
case 'E':
case 'e':
case 'D':
case 'd':
goto exp1;
case '+':
case '-':
push_char ('e');
push_char (c);
c = next_char ();
goto exp2;
default:
goto bad_real;
}
}
exp1:
push_char ('e');
c = next_char ();
if (c != '+' && c != '-')
push_char ('+');
else
{
push_char (c);
c = next_char ();
}
exp2:
if (!isdigit (c))
goto bad_real;
push_char (c);
for (;;)
{
c = next_char ();
switch (c)
{
CASE_DIGITS:
push_char (c);
break;
CASE_SEPARATORS:
unget_char (c);
eat_separator ();
goto done;
default:
goto bad_real;
}
}
done:
push_char ('\0');
if (convert_real (value, saved_string, length))
return;
free_saved ();
saved_type = BT_REAL;
return;
bad_real:
st_sprintf (message, "Bad real number in item %d of list input",
g.item_count);
generate_error (ERROR_READ_VALUE, message);
}
/* check_type()-- Check the current type against the saved type to
* make sure they are compatible. Returns nonzero if incompatible. */
static int
check_type (bt type, int len)
{
char message[100];
if (saved_type != BT_NULL && saved_type != type)
{
st_sprintf (message, "Read type %s where %s was expected for item %d",
type_name (saved_type), type_name (type), g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
if (saved_type == BT_NULL || saved_type == BT_CHARACTER)
return 0;
if (saved_length != len)
{
st_sprintf (message,
"Read kind %d %s where kind %d is required for item %d",
saved_length, type_name (saved_type), len, g.item_count);
generate_error (ERROR_READ_VALUE, message);
return 1;
}
return 0;
}
/* list_formatted_read()-- Top level data transfer subroutine for list
* reads. Because we have to deal with repeat counts, the data item
* is always saved after reading, usually in the value[] array. If a
* repeat count is greater than one, we copy the data item multiple
* times. */
void
list_formatted_read (bt type, void *p, int len)
{
char c;
int m;
namelist_mode = 0;
if (setjmp (g.eof_jump))
{
generate_error (ERROR_END, NULL);
return;
}
if (g.first_item)
{
g.first_item = 0;
input_complete = 0;
repeat_count = 1;
at_eol = 0;
c = eat_spaces ();
if (is_separator (c))
{ /* Found a null value */
eat_separator ();
repeat_count = 0;
if (at_eol)
finish_separator ();
else
return;
}
}
else
{
if (input_complete)
return;
if (repeat_count > 0)
{
if (check_type (type, len))
return;
goto set_value;
}
if (at_eol)
finish_separator ();
else
eat_spaces ();
saved_type = BT_NULL;
repeat_count = 1;
}
switch (type)
{
case BT_INTEGER:
read_integer (len);
break;
case BT_LOGICAL:
read_logical (len);
break;
case BT_CHARACTER:
read_character (len);
break;
case BT_REAL:
read_real (len);
break;
case BT_COMPLEX:
read_complex (len);
break;
default:
internal_error ("Bad type for list read");
}
if (saved_type != BT_CHARACTER && saved_type != BT_NULL)
saved_length = len;
if (ioparm.library_return != LIBRARY_OK)
return;
set_value:
switch (saved_type)
{
case BT_COMPLEX:
len = 2 * len;
/* Fall through */
case BT_INTEGER:
case BT_REAL:
case BT_LOGICAL:
memcpy (p, value, len);
break;
case BT_CHARACTER:
if (saved_string)
{
m = (len < saved_used) ? len : saved_used;
memcpy (p, saved_string, m);
}
else /* just delimiters encountered, nothing to copy but SPACE */
m = 0;
if (m < len)
memset (((char *) p) + m, ' ', len - m);
break;
case BT_NULL:
break;
}
if (--repeat_count <= 0)
free_saved ();
}
void
init_at_eol()
{
at_eol = 0;
}
/* finish_list_read()-- Finish a list read */
void
finish_list_read (void)
{
char c;
free_saved ();
if (at_eol)
{
at_eol = 0;
return;
}
do
{
c = next_char ();
}
while (c != '\n');
}
static namelist_info *
find_nml_node (char * var_name)
{
namelist_info * t = ionml;
while (t != NULL)
{
if (strcmp (var_name,t->var_name) == 0)
{
t->value_acquired = 1;
return t;
}
t = t->next;
}
return NULL;
}
static void
match_namelist_name (char *name, int len)
{
int name_len;
char c;
char * namelist_name = name;
name_len = 0;
/* Match the name of the namelist */
if (tolower (next_char ()) != tolower (namelist_name[name_len++]))
{
wrong_name:
generate_error (ERROR_READ_VALUE, "Wrong namelist name found");
return;
}
while (name_len < len)
{
c = next_char ();
if (tolower (c) != tolower (namelist_name[name_len++]))
goto wrong_name;
}
}
/********************************************************************
Namelist reads
********************************************************************/
/* namelist_read()-- Process a namelist read. This subroutine
* initializes things, positions to the first element and */
void
namelist_read (void)
{
char c;
int name_matched, next_name ;
namelist_info * nl;
int len, m;
void * p;
namelist_mode = 1;
if (setjmp (g.eof_jump))
{
generate_error (ERROR_END, NULL);
return;
}
restart:
c = next_char ();
switch (c)
{
case ' ':
goto restart;
case '!':
do
c = next_char ();
while (c != '\n');
goto restart;
case '&':
break;
default:
generate_error (ERROR_READ_VALUE, "Invalid character in namelist");
return;
}
/* Match the name of the namelist */
match_namelist_name(ioparm.namelist_name, ioparm.namelist_name_len);
/* Ready to read namelist elements */
for (;;)
{
c = next_char ();
switch (c)
{
case '&':
match_namelist_name("end",3);
return;
case '\\':
return;
case ' ':
case '\n':
case '\t':
break;
case ',':
next_name = 1;
break;
case '=':
name_matched = 1;
nl = find_nml_node (saved_string);
if (nl == NULL)
internal_error ("Can not found a valid namelist var!");
free_saved();
len = nl->len;
p = nl->mem_pos;
switch (nl->type)
{
case BT_INTEGER:
read_integer (len);
break;
case BT_LOGICAL:
read_logical (len);
break;
case BT_CHARACTER:
read_character (len);
break;
case BT_REAL:
read_real (len);
break;
case BT_COMPLEX:
read_complex (len);
break;
default:
internal_error ("Bad type for namelist read");
}
switch (saved_type)
{
case BT_COMPLEX:
len = 2 * len;
/* Fall through */
case BT_INTEGER:
case BT_REAL:
case BT_LOGICAL:
memcpy (p, value, len);
break;
case BT_CHARACTER:
m = (len < saved_used) ? len : saved_used;
memcpy (p, saved_string, m);
if (m < len)
memset (((char *) p) + m, ' ', len - m);
break;
case BT_NULL:
break;
}
break;
default :
push_char(c);
break;
}
}
}
Reference in New Issue View Git Blame Copy Permalink