From 49a549ca6bad5377245fa1ba451323c0961ec9d7 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Mon, 15 Feb 2016 22:31:13 +0000 Subject: [PATCH] 2016-02-15 Jerry DeLisle 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@233436 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/read_bang.f90 | 38 +++++++ gcc/testsuite/gfortran.dg/read_bang4.f90 | 47 +++++++++ libgfortran/ChangeLog | 15 +++ libgfortran/io/list_read.c | 166 +++++++++++++++++++------------ 5 files changed, 208 insertions(+), 64 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/read_bang.f90 create mode 100644 gcc/testsuite/gfortran.dg/read_bang4.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8987be1..020ab2b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-02-15 Jerry DeLisle + + PR libgfortran/69651 + * gfortran.dg/read_bang.f90: New test. + * gfortran.dg/read_bang4.f90: New test. + 2016-02-15 Jakub Jelinek PR c++/69658 diff --git a/gcc/testsuite/gfortran.dg/read_bang.f90 b/gcc/testsuite/gfortran.dg/read_bang.f90 new file mode 100644 index 0000000..7806ca7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_bang.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/read_bang4.f90 b/gcc/testsuite/gfortran.dg/read_bang4.f90 new file mode 100644 index 0000000..78101fc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/read_bang4.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 7d0cb66..5120a43 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,18 @@ +2016-02-15 Jerry DeLisle + + 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 PR libgfortran/69668 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index efbbcb6..fcd4b6e 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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 != '!') { -- 2.7.4