gcc/

[pf3gnuchains/gcc-fork.git] / gcc / fortran / io.c

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 7f5e575..1ecea88 100644 (file)
--- 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
+<http://www.gnu.org/licenses/>.  */
 
 #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;