re PR libfortran/69651 ([6 Regession] Usage of unitialized pointer io/list_read.c)
2016-02-15 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/69651 * io/list_read.c: Entire file trailing spaces removed. (CASE_SEPARATORS): Remove '!'. (is_separator): Add namelist mode as condition with '!'. (push_char): Remove un-needed memset. (push_char4): Likewise and remove 'new' pointer. (eat_separator): Remove un-needed use of notify_std. (read_logical): If '!' bang encountered when not in namelist mode got bad_logical to give an error. (read_integer): Likewise reject '!'. (read_character): Remove condition testing c = '!' which is now inside the is_separator macro. (parse_real): Reject '!' unless in namelist mode. (read_complex): Reject '!' unless in namelist mode. (read_real): Likewise reject '!'. PR libgfortran/69651 * gfortran.dg/read_bang.f90: New test. * gfortran.dg/read_bang4.f90: New test. From-SVN: r233436
This commit is contained in:
parent
f0516ca404
commit
fc12098dbe
5 changed files with 208 additions and 64 deletions
|
@ -1,3 +1,9 @@
|
|||
2016-02-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libgfortran/69651
|
||||
* gfortran.dg/read_bang.f90: New test.
|
||||
* gfortran.dg/read_bang4.f90: New test.
|
||||
|
||||
2016-02-15 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR c++/69658
|
||||
|
|
38
gcc/testsuite/gfortran.dg/read_bang.f90
Normal file
38
gcc/testsuite/gfortran.dg/read_bang.f90
Normal file
|
@ -0,0 +1,38 @@
|
|||
! { dg-do run }
|
||||
! PR69651 Usage of unitialized pointer io/list_read.c
|
||||
! Note: The uninitialized pointer was not the cause of the problem
|
||||
! observed with this test case. The problem was mishandling '!'
|
||||
! See also test case read_bang4.f90.
|
||||
program test
|
||||
implicit none
|
||||
integer :: i, j, ios
|
||||
real :: r, s
|
||||
complex :: c, d
|
||||
character(20) :: str1, str2
|
||||
|
||||
i = -5
|
||||
j = -6
|
||||
r = -3.14
|
||||
s = -2.71
|
||||
c = (-1.1,-2.2)
|
||||
d = (-3.3,-4.4)
|
||||
str1 = "candy"
|
||||
str2 = "peppermint"
|
||||
open(15, status='scratch')
|
||||
write(15,*) "10 1!2"
|
||||
write(15,*) " 23.5! 34.5"
|
||||
write(15,*) " (67.50,69.25) (51.25,87.75)!"
|
||||
write(15,*) " 'abcdefgh!' ' !klmnopq!'"
|
||||
rewind(15)
|
||||
read(15,*,iostat=ios) i, j
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) r, s
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) c, d
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) str1, str2
|
||||
if (ios.ne.0) call abort
|
||||
if (str1.ne."abcdefgh!") print *, str1
|
||||
if (str2.ne." !klmnopq!") print *, str2
|
||||
close(15)
|
||||
end program
|
47
gcc/testsuite/gfortran.dg/read_bang4.f90
Normal file
47
gcc/testsuite/gfortran.dg/read_bang4.f90
Normal file
|
@ -0,0 +1,47 @@
|
|||
! { dg-do run }
|
||||
! PR69651 Usage of unitialized pointer io/list_read.c
|
||||
! Note: The uninitialized pointer was not the cause of the problem
|
||||
! observed with this test case. This tests the case with UTF-8
|
||||
! files. The large string test the realloc use in push_char4 of
|
||||
! list_read.c
|
||||
program test
|
||||
implicit none
|
||||
integer :: i, j, k, ios
|
||||
integer, parameter :: big = 600
|
||||
real :: r, s
|
||||
complex :: c, d
|
||||
character(kind=4,len=big) :: str1, str2, str3
|
||||
|
||||
do i=1,big, 10
|
||||
do j = 0, 9
|
||||
k = i + j
|
||||
str2(k:k) = char(65+j)
|
||||
end do
|
||||
end do
|
||||
i = -5
|
||||
j = -6
|
||||
r = -3.14
|
||||
s = -2.71
|
||||
c = (-1.1,-2.2)
|
||||
d = (-3.3,-4.4)
|
||||
str3 = str2
|
||||
open(15, status='scratch', encoding="utf-8")
|
||||
write(15,*) "10 1!2"
|
||||
write(15,*) " 23.5! 34.5"
|
||||
write(15,*) " (67.50,69.25) (51.25,87.75)!"
|
||||
write(15,*) " 'abcdefgh!'", " ", str2
|
||||
rewind(15)
|
||||
str1 = 4_"candy"
|
||||
str2 = 4_"peppermint"
|
||||
read(15,*,iostat=ios) i, j
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) r, s
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) c, d
|
||||
if (ios.ne.5010) call abort
|
||||
read(15,*,iostat=ios) str1, str2
|
||||
if (ios.ne.0) call abort
|
||||
if (str1.ne.4_"abcdefgh!") call abort
|
||||
if (str2.ne.str3) call abort
|
||||
close(15)
|
||||
end program
|
|
@ -1,3 +1,18 @@
|
|||
2016-02-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libgfortran/69651
|
||||
* io/list_read.c: Entire file trailing spaces removed.
|
||||
(CASE_SEPARATORS): Remove '!'.
|
||||
(is_separator): Add namelist mode as condition with '!'.
|
||||
(push_char): Remove un-needed memset. (push_char4): Likewise and remove
|
||||
'new' pointer. (eat_separator): Remove un-needed use of notify_std.
|
||||
(read_logical): If '!' bang encountered when not in namelist mode got
|
||||
bad_logical to give an error. (read_integer): Likewise reject '!'.
|
||||
(read_character): Remove condition testing c = '!' which is now inside
|
||||
the is_separator macro. (parse_real): Reject '!' unless in namelist mode.
|
||||
(read_complex): Reject '!' unless in namelist mode. (read_real): Likewise
|
||||
reject '!'.
|
||||
|
||||
2016-02-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR libgfortran/69668
|
||||
|
|
|
@ -52,13 +52,14 @@ typedef unsigned char uchar;
|
|||
#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': \
|
||||
case '\r': case ';': case '!'
|
||||
#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': \
|
||||
case '\t': case '\r': case ';'
|
||||
|
||||
/* This macro assumes that we're operating on a variable. */
|
||||
|
||||
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
|
||||
|| c == '\t' || c == '\r' || c == ';' || c == '!')
|
||||
|| c == '\t' || c == '\r' || c == ';' || \
|
||||
(dtp->u.p.namelist_mode && c == '!'))
|
||||
|
||||
/* Maximum repeat count. Less than ten times the maximum signed int32. */
|
||||
|
||||
|
@ -75,7 +76,7 @@ typedef unsigned char uchar;
|
|||
|
||||
/* Worker function to save a default KIND=1 character to a string
|
||||
buffer, enlarging it as necessary. */
|
||||
|
||||
|
||||
static void
|
||||
push_char_default (st_parameter_dt *dtp, int c)
|
||||
{
|
||||
|
@ -92,13 +93,8 @@ push_char_default (st_parameter_dt *dtp, int c)
|
|||
if (dtp->u.p.saved_used >= dtp->u.p.saved_length)
|
||||
{
|
||||
dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
|
||||
dtp->u.p.saved_string =
|
||||
dtp->u.p.saved_string =
|
||||
xrealloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
|
||||
|
||||
// Also this should not be necessary.
|
||||
memset (dtp->u.p.saved_string + dtp->u.p.saved_used, 0,
|
||||
dtp->u.p.saved_length - dtp->u.p.saved_used);
|
||||
|
||||
}
|
||||
|
||||
dtp->u.p.saved_string[dtp->u.p.saved_used++] = (char) c;
|
||||
|
@ -107,11 +103,10 @@ push_char_default (st_parameter_dt *dtp, int c)
|
|||
|
||||
/* Worker function to save a KIND=4 character to a string buffer,
|
||||
enlarging the buffer as necessary. */
|
||||
|
||||
static void
|
||||
push_char4 (st_parameter_dt *dtp, int c)
|
||||
{
|
||||
gfc_char4_t *new, *p = (gfc_char4_t *) dtp->u.p.saved_string;
|
||||
gfc_char4_t *p = (gfc_char4_t *) dtp->u.p.saved_string;
|
||||
|
||||
if (p == NULL)
|
||||
{
|
||||
|
@ -125,9 +120,6 @@ push_char4 (st_parameter_dt *dtp, int c)
|
|||
{
|
||||
dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
|
||||
p = xrealloc (p, dtp->u.p.saved_length * sizeof (gfc_char4_t));
|
||||
|
||||
memset4 (new + dtp->u.p.saved_used, 0,
|
||||
dtp->u.p.saved_length - dtp->u.p.saved_used);
|
||||
}
|
||||
|
||||
p[dtp->u.p.saved_used++] = c;
|
||||
|
@ -168,7 +160,7 @@ free_line (st_parameter_dt *dtp)
|
|||
/* Unget saves the last character so when reading the next character,
|
||||
we need to check to see if there is a character waiting. Similar,
|
||||
if the line buffer is being used to read_logical, check it too. */
|
||||
|
||||
|
||||
static int
|
||||
check_buffers (st_parameter_dt *dtp)
|
||||
{
|
||||
|
@ -200,7 +192,7 @@ check_buffers (st_parameter_dt *dtp)
|
|||
dtp->u.p.line_buffer_pos = 0;
|
||||
dtp->u.p.line_buffer_enabled = 0;
|
||||
}
|
||||
|
||||
|
||||
done:
|
||||
dtp->u.p.at_eol = (c == '\n' || c == EOF);
|
||||
return c;
|
||||
|
@ -254,7 +246,7 @@ next_char_internal (st_parameter_dt *dtp)
|
|||
record = next_array_record (dtp, dtp->u.p.current_unit->ls,
|
||||
&finished);
|
||||
|
||||
/* Check for "end-of-file" condition. */
|
||||
/* Check for "end-of-file" condition. */
|
||||
if (finished)
|
||||
{
|
||||
dtp->u.p.at_eof = 1;
|
||||
|
@ -289,17 +281,17 @@ next_char_internal (st_parameter_dt *dtp)
|
|||
|
||||
if (is_array_io (dtp))
|
||||
{
|
||||
/* Check whether we hit EOF. */
|
||||
/* Check whether we hit EOF. */
|
||||
if (unlikely (length == 0))
|
||||
{
|
||||
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
|
||||
return '\0';
|
||||
}
|
||||
}
|
||||
dtp->u.p.current_unit->bytes_left--;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (dtp->u.p.at_eof)
|
||||
if (dtp->u.p.at_eof)
|
||||
return EOF;
|
||||
if (length == 0)
|
||||
{
|
||||
|
@ -316,7 +308,7 @@ done:
|
|||
|
||||
/* Worker function for UTF encoded files. */
|
||||
static int
|
||||
next_char_utf8 (st_parameter_dt *dtp)
|
||||
next_char_utf8 (st_parameter_dt *dtp)
|
||||
{
|
||||
static const uchar masks[6] = { 0x7F, 0x1F, 0x0F, 0x07, 0x02, 0x01 };
|
||||
static const uchar patns[6] = { 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC };
|
||||
|
@ -336,7 +328,7 @@ next_char_utf8 (st_parameter_dt *dtp)
|
|||
if ((c & ~masks[nb-1]) == patns[nb-1])
|
||||
goto found;
|
||||
goto invalid;
|
||||
|
||||
|
||||
found:
|
||||
c = (c & masks[nb-1]);
|
||||
|
||||
|
@ -363,7 +355,7 @@ next_char_utf8 (st_parameter_dt *dtp)
|
|||
utf_done:
|
||||
dtp->u.p.at_eol = (c == '\n' || c == (gfc_char4_t) EOF);
|
||||
return (int) c;
|
||||
|
||||
|
||||
invalid:
|
||||
generate_error (&dtp->common, LIBERROR_READ_VALUE, "Invalid UTF-8 encoding");
|
||||
return (gfc_char4_t) '?';
|
||||
|
@ -457,7 +449,7 @@ eat_line (st_parameter_dt *dtp)
|
|||
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.
|
||||
of the separator.
|
||||
|
||||
Returns 0 for success, and non-zero error code otherwise. */
|
||||
|
||||
|
@ -521,11 +513,9 @@ eat_separator (st_parameter_dt *dtp)
|
|||
break;
|
||||
|
||||
case '!':
|
||||
/* Eat a namelist comment. */
|
||||
if (dtp->u.p.namelist_mode)
|
||||
{ /* Eat a namelist comment. */
|
||||
notify_std (&dtp->common, GFC_STD_GNU,
|
||||
"'!' in namelist is not a valid separator,"
|
||||
" try inserting a space");
|
||||
{
|
||||
err = eat_line (dtp);
|
||||
if (err)
|
||||
return err;
|
||||
|
@ -789,7 +779,7 @@ 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
|
||||
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. */
|
||||
|
||||
|
@ -855,6 +845,10 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_logical;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
unget_char (dtp, c);
|
||||
|
@ -903,7 +897,7 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
goto logical_done;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
l_push_char (dtp, c);
|
||||
if (c == '=')
|
||||
{
|
||||
|
@ -912,7 +906,7 @@ read_logical (st_parameter_dt *dtp, int length)
|
|||
dtp->u.p.line_buffer_pos = 0;
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
bad_logical:
|
||||
|
@ -974,6 +968,10 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
goto bad_integer;
|
||||
goto get_integer;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_integer;
|
||||
|
||||
CASE_SEPARATORS: /* Single null. */
|
||||
unget_char (dtp, c);
|
||||
eat_separator (dtp);
|
||||
|
@ -1002,6 +1000,10 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
push_char (dtp, '\0');
|
||||
goto repeat;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_integer;
|
||||
|
||||
CASE_SEPARATORS: /* Not a repeat count. */
|
||||
case EOF:
|
||||
goto done;
|
||||
|
@ -1024,6 +1026,10 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
CASE_DIGITS:
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_integer;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
unget_char (dtp, c);
|
||||
eat_separator (dtp);
|
||||
|
@ -1052,6 +1058,10 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
push_char (dtp, c);
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_integer;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
goto done;
|
||||
|
@ -1066,7 +1076,7 @@ read_integer (st_parameter_dt *dtp, int length)
|
|||
if (nml_bad_return (dtp, c))
|
||||
return;
|
||||
|
||||
free_saved (dtp);
|
||||
free_saved (dtp);
|
||||
if (c == EOF)
|
||||
{
|
||||
free_line (dtp);
|
||||
|
@ -1204,10 +1214,10 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
push_char (dtp, c);
|
||||
break;
|
||||
}
|
||||
|
||||
|
||||
/* See if we have a doubled quote character or the end of
|
||||
the string. */
|
||||
|
||||
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto done_eof;
|
||||
if (c == quote)
|
||||
|
@ -1215,21 +1225,21 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
push_char (dtp, quote);
|
||||
break;
|
||||
}
|
||||
|
||||
|
||||
unget_char (dtp, c);
|
||||
goto done;
|
||||
|
||||
|
||||
CASE_SEPARATORS:
|
||||
if (quote == ' ')
|
||||
{
|
||||
unget_char (dtp, c);
|
||||
goto done;
|
||||
}
|
||||
|
||||
|
||||
if (c != '\n' && c != '\r')
|
||||
push_char (dtp, c);
|
||||
break;
|
||||
|
||||
|
||||
default:
|
||||
push_char (dtp, c);
|
||||
break;
|
||||
|
@ -1241,13 +1251,13 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
|
|||
done:
|
||||
c = next_char (dtp);
|
||||
done_eof:
|
||||
if (is_separator (c) || c == '!' || c == EOF)
|
||||
if (is_separator (c) || c == EOF)
|
||||
{
|
||||
unget_char (dtp, c);
|
||||
eat_separator (dtp);
|
||||
dtp->u.p.saved_type = BT_CHARACTER;
|
||||
}
|
||||
else
|
||||
else
|
||||
{
|
||||
free_saved (dtp);
|
||||
snprintf (message, MSGLEN, "Invalid string input in item %d",
|
||||
|
@ -1275,7 +1285,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
|
||||
if ((c = next_char (dtp)) == EOF)
|
||||
goto bad;
|
||||
|
||||
|
||||
if (c == '-' || c == '+')
|
||||
{
|
||||
push_char (dtp, c);
|
||||
|
@ -1285,7 +1295,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
|
||||
if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
|
||||
c = '.';
|
||||
|
||||
|
||||
if (!isdigit (c) && c != '.')
|
||||
{
|
||||
if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
|
||||
|
@ -1335,6 +1345,10 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
goto bad;
|
||||
goto exp2;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
goto done;
|
||||
|
@ -1371,6 +1385,10 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
push_char (dtp, c);
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
unget_char (dtp, c);
|
||||
|
@ -1431,7 +1449,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
|
|||
push_char (dtp, 'n');
|
||||
push_char (dtp, 'a');
|
||||
push_char (dtp, 'n');
|
||||
|
||||
|
||||
/* Match "NAN(alphanum)". */
|
||||
if (c == '(')
|
||||
{
|
||||
|
@ -1488,6 +1506,10 @@ read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size)
|
|||
case '(':
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_complex;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
unget_char (dtp, c);
|
||||
|
@ -1531,7 +1553,7 @@ eol_3:
|
|||
|
||||
if (parse_real (dtp, dest + size / 2, kind))
|
||||
return;
|
||||
|
||||
|
||||
eol_4:
|
||||
eat_spaces (dtp);
|
||||
c = next_char (dtp);
|
||||
|
@ -1566,7 +1588,7 @@ eol_4:
|
|||
hit_eof (dtp);
|
||||
return;
|
||||
}
|
||||
else if (c != '\n')
|
||||
else if (c != '\n')
|
||||
eat_line (dtp);
|
||||
|
||||
snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
|
||||
|
@ -1606,6 +1628,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
case '-':
|
||||
goto got_sign;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_real;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
unget_char (dtp, c); /* Single null. */
|
||||
eat_separator (dtp);
|
||||
|
@ -1661,6 +1687,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
push_char (dtp, '\0');
|
||||
goto got_repeat;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_real;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
if (c != '\n' && c != ',' && c != '\r' && c != ';')
|
||||
|
@ -1730,6 +1760,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
push_char (dtp, c);
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_real;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
goto done;
|
||||
|
@ -1790,6 +1824,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
push_char (dtp, c);
|
||||
break;
|
||||
|
||||
case '!':
|
||||
if (!dtp->u.p.namelist_mode)
|
||||
goto bad_real;
|
||||
|
||||
CASE_SEPARATORS:
|
||||
case EOF:
|
||||
goto done;
|
||||
|
@ -1887,7 +1925,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
|
|||
goto unwind;
|
||||
|
||||
if (dtp->u.p.namelist_mode)
|
||||
{
|
||||
{
|
||||
if (c == ' ' || c =='\n' || c == '\r')
|
||||
{
|
||||
do
|
||||
|
@ -2046,7 +2084,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
|
|||
dtp->u.p.input_complete = 0;
|
||||
dtp->u.p.repeat_count = 1;
|
||||
dtp->u.p.at_eol = 0;
|
||||
|
||||
|
||||
if ((c = eat_spaces (dtp)) == EOF)
|
||||
{
|
||||
err = LIBERROR_END;
|
||||
|
@ -2080,7 +2118,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
|
|||
return err;
|
||||
goto set_value;
|
||||
}
|
||||
|
||||
|
||||
if (dtp->u.p.input_complete)
|
||||
goto cleanup;
|
||||
|
||||
|
@ -2219,7 +2257,7 @@ list_formatted_read (st_parameter_dt *dtp, bt type, void *p, int kind,
|
|||
for (elem = 0; elem < nelems; elem++)
|
||||
{
|
||||
dtp->u.p.item_count++;
|
||||
err = list_formatted_read_scalar (dtp, type, tmp + stride*elem,
|
||||
err = list_formatted_read_scalar (dtp, type, tmp + stride*elem,
|
||||
kind, size);
|
||||
if (err)
|
||||
break;
|
||||
|
@ -2362,10 +2400,10 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
|| (c==')' && dim < rank -1))
|
||||
{
|
||||
if (is_char)
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad substring qualifier");
|
||||
else
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad number of index fields");
|
||||
goto err_ret;
|
||||
}
|
||||
|
@ -2384,7 +2422,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad character in substring qualifier");
|
||||
else
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad character in index");
|
||||
goto err_ret;
|
||||
}
|
||||
|
@ -2393,10 +2431,10 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
&& dtp->u.p.saved_string == 0)
|
||||
{
|
||||
if (is_char)
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Null substring qualifier");
|
||||
else
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Null index field");
|
||||
goto err_ret;
|
||||
}
|
||||
|
@ -2405,7 +2443,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
|| (indx == 2 && dtp->u.p.saved_string == 0))
|
||||
{
|
||||
if (is_char)
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad substring qualifier");
|
||||
else
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
|
@ -2494,10 +2532,10 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
|| (ls[dim].end < GFC_DIMENSION_LBOUND(ad[dim])))
|
||||
{
|
||||
if (is_char)
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Substring out of range");
|
||||
else
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Index %d out of range", dim + 1);
|
||||
goto err_ret;
|
||||
}
|
||||
|
@ -2505,7 +2543,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
|
|||
if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0)
|
||||
|| (ls[dim].step == 0))
|
||||
{
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
snprintf (parse_err_msg, parse_err_msg_size,
|
||||
"Bad range in index %d", dim + 1);
|
||||
goto err_ret;
|
||||
}
|
||||
|
@ -2548,7 +2586,7 @@ static bool
|
|||
strcmp_extended_type (char *p, char *q)
|
||||
{
|
||||
char *r, *s;
|
||||
|
||||
|
||||
for (r = p, s = q; *r && *s; r++, s++)
|
||||
{
|
||||
if (*r != *s)
|
||||
|
@ -3056,7 +3094,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
|
|||
goto nml_err_ret;
|
||||
if (c != '?')
|
||||
{
|
||||
snprintf (nml_err_msg, nml_err_msg_size,
|
||||
snprintf (nml_err_msg, nml_err_msg_size,
|
||||
"namelist read: misplaced = sign");
|
||||
goto nml_err_ret;
|
||||
}
|
||||
|
@ -3072,7 +3110,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
|
|||
nml_match_name (dtp, "end", 3);
|
||||
if (dtp->u.p.nml_read_error)
|
||||
{
|
||||
snprintf (nml_err_msg, nml_err_msg_size,
|
||||
snprintf (nml_err_msg, nml_err_msg_size,
|
||||
"namelist not terminated with / or &end");
|
||||
goto nml_err_ret;
|
||||
}
|
||||
|
@ -3367,7 +3405,7 @@ namelist_read (st_parameter_dt *dtp)
|
|||
dtp->u.p.namelist_mode = 1;
|
||||
dtp->u.p.input_complete = 0;
|
||||
dtp->u.p.expanded_read = 0;
|
||||
|
||||
|
||||
/* Set the next_char and push_char worker functions. */
|
||||
set_workers (dtp);
|
||||
|
||||
|
@ -3413,7 +3451,7 @@ find_nml_name:
|
|||
if (dtp->u.p.nml_read_error)
|
||||
goto find_nml_name;
|
||||
|
||||
/* A trailing space is required, we give a little latitude here, 10.9.1. */
|
||||
/* A trailing space is required, we give a little latitude here, 10.9.1. */
|
||||
c = next_char (dtp);
|
||||
if (!is_separator(c) && c != '!')
|
||||
{
|
||||
|
|
Loading…
Add table
Reference in a new issue