X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Fio.c;h=1ecea88eb18143ce50baf4876a27c60c478cd2e7;hb=7938ee8cfc0017a56ad839e2624b953d6c5465af;hp=7f5e575ab36a1604cf7f2165b661aa41b687dc0b;hpb=db697236acc86157bcca24d4a9c78d59b5c161d8;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 7f5e575ab36..1ecea88eb18 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -7,7 +7,7 @@ This file is part of GCC. GCC 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 +Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY @@ -16,9 +16,8 @@ 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 GCC; see the file COPYING. If not, write to the Free -Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA -02110-1301, USA. */ +along with GCC; see the file COPYING3. If not see +. */ #include "config.h" #include "system.h" @@ -98,7 +97,7 @@ typedef enum FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_POS, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, - FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END + FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR } format_token; @@ -176,12 +175,23 @@ unget_char (void) /* Eat up the spaces and return a character. */ static char -next_char_not_space (void) +next_char_not_space (bool *error) { char c; do { c = next_char (0); + if (c == '\t') + { + if (gfc_option.allow_std & GFC_STD_GNU) + gfc_warning ("Extension: Tab character in format at %C"); + else + { + gfc_error ("Extension: Tab character in format at %C"); + *error = true; + return c; + } + } } while (gfc_is_whitespace (c)); return c; @@ -199,6 +209,7 @@ format_lex (void) char c, delim; int zflag; int negative_flag; + bool error = false; if (saved_token != FMT_NONE) { @@ -207,7 +218,7 @@ format_lex (void) return token; } - c = next_char_not_space (); + c = next_char_not_space (&error); negative_flag = 0; switch (c) @@ -215,7 +226,7 @@ format_lex (void) case '-': negative_flag = 1; case '+': - c = next_char_not_space (); + c = next_char_not_space (&error); if (!ISDIGIT (c)) { token = FMT_UNKNOWN; @@ -226,7 +237,7 @@ format_lex (void) do { - c = next_char_not_space (); + c = next_char_not_space (&error); if (ISDIGIT (c)) value = 10 * value + c - '0'; } @@ -256,7 +267,7 @@ format_lex (void) do { - c = next_char_not_space (); + c = next_char_not_space (&error); if (ISDIGIT (c)) { value = 10 * value + c - '0'; @@ -291,7 +302,7 @@ format_lex (void) break; case 'T': - c = next_char_not_space (); + c = next_char_not_space (&error); if (c != 'L' && c != 'R') unget_char (); @@ -311,7 +322,7 @@ format_lex (void) break; case 'S': - c = next_char_not_space (); + c = next_char_not_space (&error); if (c != 'P' && c != 'S') unget_char (); @@ -319,7 +330,7 @@ format_lex (void) break; case 'B': - c = next_char_not_space (); + c = next_char_not_space (&error); if (c == 'N' || c == 'Z') token = FMT_BLANK; else @@ -381,7 +392,7 @@ format_lex (void) break; case 'E': - c = next_char_not_space (); + c = next_char_not_space (&error); if (c == 'N' || c == 'S') token = FMT_EXT; else @@ -421,6 +432,9 @@ format_lex (void) break; } + if (error) + return FMT_ERROR; + return token; } @@ -451,6 +465,8 @@ check_format (bool is_input) rv = SUCCESS; t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_LPAREN) { error = _("Missing leading left parenthesis"); @@ -458,6 +474,8 @@ check_format (bool is_input) } t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t == FMT_RPAREN) goto finished; /* Empty format is legal */ saved_token = t; @@ -465,12 +483,16 @@ check_format (bool is_input) format_item: /* In this state, the next thing has to be a format item. */ t = format_lex (); + if (t == FMT_ERROR) + goto fail; format_item_1: switch (t) { case FMT_POSINT: repeat = value; t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t == FMT_LPAREN) { level++; @@ -490,6 +512,8 @@ format_item_1: case FMT_ZERO: /* Signed integer can only precede a P format. */ t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_P) { error = _("Expected P edit descriptor"); @@ -524,6 +548,8 @@ format_item_1: case FMT_DOLLAR: t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C") == FAILURE) @@ -571,6 +597,8 @@ data_desc: if (pedantic) { t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t == FMT_POSINT) { error = _("Repeat count cannot follow P descriptor"); @@ -585,6 +613,8 @@ data_desc: case FMT_POS: case FMT_L: t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t == FMT_POSINT) break; @@ -611,6 +641,8 @@ data_desc: case FMT_A: t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_POSINT) saved_token = t; break; @@ -620,6 +652,8 @@ data_desc: case FMT_G: case FMT_EXT: u = format_lex (); + if (u == FMT_ERROR) + goto fail; if (u != FMT_POSINT) { error = posint_required; @@ -627,6 +661,8 @@ data_desc: } u = format_lex (); + if (u == FMT_ERROR) + goto fail; if (u != FMT_PERIOD) { /* Warn if -std=legacy, otherwise error. */ @@ -639,6 +675,8 @@ data_desc: } u = format_lex (); + if (u == FMT_ERROR) + goto fail; if (u != FMT_ZERO && u != FMT_POSINT) { error = nonneg_required; @@ -650,6 +688,8 @@ data_desc: /* Look for optional exponent. */ u = format_lex (); + if (u == FMT_ERROR) + goto fail; if (u != FMT_E) { saved_token = u; @@ -657,6 +697,8 @@ data_desc: else { u = format_lex (); + if (u == FMT_ERROR) + goto fail; if (u != FMT_POSINT) { error = _("Positive exponent width required"); @@ -668,6 +710,8 @@ data_desc: case FMT_F: t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_ZERO && t != FMT_POSINT) { error = nonneg_required; @@ -680,6 +724,8 @@ data_desc: } t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_PERIOD) { /* Warn if -std=legacy, otherwise error. */ @@ -692,6 +738,8 @@ data_desc: } t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_ZERO && t != FMT_POSINT) { error = nonneg_required; @@ -722,6 +770,8 @@ data_desc: case FMT_IBOZ: t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_ZERO && t != FMT_POSINT) { error = nonneg_required; @@ -734,6 +784,8 @@ data_desc: } t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_PERIOD) { saved_token = t; @@ -741,6 +793,8 @@ data_desc: else { t = format_lex (); + if (t == FMT_ERROR) + goto fail; if (t != FMT_ZERO && t != FMT_POSINT) { error = nonneg_required; @@ -758,6 +812,8 @@ data_desc: between_desc: /* Between a descriptor and what comes next. */ t = format_lex (); + if (t == FMT_ERROR) + goto fail; switch (t) { @@ -789,6 +845,8 @@ optional_comma: /* Optional comma is a weird between state where we've just finished reading a colon, slash, dollar or P descriptor. */ t = format_lex (); + if (t == FMT_ERROR) + goto fail; optional_comma_1: switch (t) { @@ -812,6 +870,8 @@ optional_comma_1: extension_optional_comma: /* As a GNU extension, permit a missing comma after a string literal. */ t = format_lex (); + if (t == FMT_ERROR) + goto fail; switch (t) { case FMT_COMMA: @@ -843,7 +903,7 @@ extension_optional_comma: syntax: gfc_error ("%s in format string at %C", error); - +fail: /* TODO: More elaborate measures are needed to show where a problem is within a format string that has been calculated. */ rv = FAILURE; @@ -2915,9 +2975,8 @@ get_io_list: /* Optional leading comma (non-standard). */ if (!comma_flag && gfc_match_char (',') == MATCH_YES - && k == M_WRITE - && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before output " - "item list at %C is an extension") == FAILURE) + && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o " + "item list at %C") == FAILURE) return MATCH_ERROR; io_code = NULL;