OSDN Git Service

PR fortran/32860
[pf3gnuchains/gcc-fork.git] / gcc / fortran / error.c
index dc4a6cf..add23ce 100644 (file)
@@ -1,13 +1,13 @@
 /* Handle errors.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
-   Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught & Niels Kristian Bech Jensen
 
 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/>.  */
 
 /* Handle the inevitable errors.  A major catch here is that things
    flagged as errors in one match subroutine can conceivably be legal
@@ -69,12 +68,10 @@ error_char (char c)
     {
       if (cur_error_buffer->index >= cur_error_buffer->allocated)
        {
-         cur_error_buffer->allocated =
-           cur_error_buffer->allocated
-           ? cur_error_buffer->allocated * 2 : 1000;
-         cur_error_buffer->message
-           = xrealloc (cur_error_buffer->message,
-                       cur_error_buffer->allocated);
+         cur_error_buffer->allocated = cur_error_buffer->allocated
+                                     ? cur_error_buffer->allocated * 2 : 1000;
+         cur_error_buffer->message = xrealloc (cur_error_buffer->message,
+                                               cur_error_buffer->allocated);
        }
       cur_error_buffer->message[cur_error_buffer->index++] = c;
     }
@@ -114,33 +111,97 @@ error_string (const char *p)
 }
 
 
-/* Show the file, where it was included and the source line, give a
+/* Print a formatted integer to the error buffer or output.  */
+
+#define IBUF_LEN 60
+
+static void
+error_uinteger (unsigned long int i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_integer (long int i)
+{
+  unsigned long int u;
+
+  if (i < 0)
+    {
+      u = (unsigned long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+/* Show the file, where it was included, and the source line, give a
    locus.  Calls error_printf() recursively, but the recursion is at
    most one level deep.  */
 
 static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 
 static void
-show_locus (int offset, locus * loc)
+show_locus (locus *loc, int c1, int c2)
 {
   gfc_linebuf *lb;
   gfc_file *f;
   char c, *p;
-  int i, m;
+  int i, m, offset, cmax;
 
   /* TODO: Either limit the total length and number of included files
      displayed or add buffering of arbitrary number of characters in
      error messages.  */
 
+  /* Write out the error header line, giving the source file and error
+     location (in GNU standard "[file]:[line].[column]:" format),
+     followed by an "included by" stack and a blank line.  This header
+     format is matched by a testsuite parser defined in
+     lib/gfortran-dg.exp.  */
+
   lb = loc->lb;
   f = lb->file;
-  error_printf ("%s:%d:\n", f->filename,
+
+  error_string (f->filename);
+  error_char (':');
+    
 #ifdef USE_MAPPED_LOCATION
-               LOCATION_LINE (lb->location)
+  error_integer (LOCATION_LINE (lb->location));
 #else
-               lb->linenum
+  error_integer (lb->linenum);
 #endif
-               );
+
+  if ((c1 > 0) || (c2 > 0))
+    error_char ('.');
+
+  if (c1 > 0)
+    error_integer (c1);
+
+  if ((c1 > 0) && (c2 > 0))
+    error_char ('-');
+
+  if (c2 > 0)
+    error_integer (c2);
+
+  error_char (':');
+  error_char ('\n');
 
   for (;;)
     {
@@ -149,11 +210,45 @@ show_locus (int offset, locus * loc)
       f = f->included_by;
       if (f == NULL) break;
 
-      error_printf ("    Included at %s:%d\n", f->filename, i);
+      error_printf ("    Included at %s:%d:", f->filename, i);
     }
 
+  error_char ('\n');
+
+  /* Calculate an appropriate horizontal offset of the source line in
+     order to get the error locus within the visible portion of the
+     line.  Note that if the margin of 5 here is changed, the
+     corresponding margin of 10 in show_loci should be changed.  */
+
+  offset = 0;
+
+  /* When the loci is not associated with a column, it will have a
+     value of zero.  We adjust this to 1 so that it will appear.  */
+     
+  if (c1 == 0)
+    c1 = 1;
+  if (c2 == 0)
+    c2 = 1;
+
+  /* If the two loci would appear in the same column, we shift
+     '2' one column to the right, so as to print '12' rather than
+     just '1'.  We do this here so it will be accounted for in the
+     margin calculations.  */
+
+  if (c1 == c2)
+    c2 += 1;
+
+  cmax = (c1 < c2) ? c2 : c1;
+  if (cmax > terminal_width - 5)
+    offset = cmax - terminal_width + 5;
+
   /* Show the line itself, taking care not to print more than what can
-     show up on the terminal.  Tabs are converted to spaces.  */
+     show up on the terminal.  Tabs are converted to spaces, and 
+     nonprintable characters are converted to a "\xNN" sequence.  */
+
+  /* TODO: Although setting i to the terminal width is clever, it fails
+     to work correctly when nonprintable characters exist.  A better 
+     solution should be found.  */
 
   p = lb->line + offset;
   i = strlen (p);
@@ -186,18 +281,37 @@ show_locus (int offset, locus * loc)
     }
 
   error_char ('\n');
+
+  /* Show the '1' and/or '2' corresponding to the column of the error
+     locus.  Note that a value of -1 for c1 or c2 will simply cause 
+     the relevant number not to be printed.  */
+
+  c1 -= offset;
+  c2 -= offset;
+
+  for (i = 1; i <= cmax; i++)
+    {
+      if (i == c1)
+       error_char ('1');
+      else if (i == c2)
+       error_char ('2');
+      else
+       error_char (' ');
+    }
+
+  error_char ('\n');
+
 }
 
 
 /* As part of printing an error, we show the source lines that caused
-   the problem.  We show at least one, possibly two loci.  If we're
-   showing two loci and they both refer to the same file and line, we
-   only print the line once.  */
+   the problem.  We show at least one, and possibly two loci; the two
+   loci may or may not be on the same source line.  */
 
 static void
-show_loci (locus * l1, locus * l2)
+show_loci (locus *l1, locus *l2)
 {
-  int offset, flag, i, m, c1, c2, cmax;
+  int m, c1, c2;
 
   if (l1 == NULL || l1->lb == NULL)
     {
@@ -205,10 +319,16 @@ show_loci (locus * l1, locus * l2)
       return;
     }
 
+  /* While calculating parameters for printing the loci, we consider possible
+     reasons for printing one per line.  If appropriate, print the loci
+     individually; otherwise we print them both on the same line.  */
+
   c1 = l1->nextc - l1->lb->line;
-  c2 = 0;
   if (l2 == NULL)
-    goto separate;
+    {
+      show_locus (l1, c1, -1);
+      return;
+    }
 
   c2 = l2->nextc - l2->lb->line;
 
@@ -217,83 +337,19 @@ show_loci (locus * l1, locus * l2)
   else
     m = c1 - c2;
 
+  /* Note that the margin value of 10 here needs to be less than the 
+     margin of 5 used in the calculation of offset in show_locus.  */
 
   if (l1->lb != l2->lb || m > terminal_width - 10)
-    goto separate;
-
-  offset = 0;
-  cmax = (c1 < c2) ? c2 : c1;
-  if (cmax > terminal_width - 5)
-    offset = cmax - terminal_width + 5;
-
-  if (offset < 0)
-    offset = 0;
-
-  c1 -= offset;
-  c2 -= offset;
-
-  show_locus (offset, l1);
-
-  /* Arrange that '1' and '2' will show up even if the two columns are equal.  */
-  for (i = 1; i <= cmax; i++)
     {
-      flag = 0;
-      if (i == c1)
-       {
-         error_char ('1');
-         flag = 1;
-       }
-      if (i == c2)
-       {
-         error_char ('2');
-         flag = 1;
-       }
-      if (flag == 0)
-       error_char (' ');
+      show_locus (l1, c1, -1);
+      show_locus (l2, -1, c2);
+      return;
     }
 
-  error_char ('\n');
+  show_locus (l1, c1, c2);
 
   return;
-
-separate:
-  offset = 0;
-
-  if (c1 > terminal_width - 5)
-    {
-      offset = c1 - 5;
-      if (offset < 0)
-       offset = 0;
-      c1 = c1 - offset;
-    }
-
-  show_locus (offset, l1);
-  for (i = 1; i < c1; i++)
-    error_char (' ');
-
-  error_char ('1');
-  error_char ('\n');
-
-  if (l2 != NULL)
-    {
-      offset = 0;
-
-      if (c2 > terminal_width - 20)
-       {
-         offset = c2 - 20;
-         if (offset < 0)
-           offset = 0;
-         c2 = c2 - offset;
-       }
-
-      show_locus (offset, l2);
-
-      for (i = 1; i < c2; i++)
-       error_char (' ');
-
-      error_char ('2');
-      error_char ('\n');
-    }
 }
 
 
@@ -301,87 +357,212 @@ separate:
    inspired by g77's error handling and is similar to printf() with
    the following %-codes:
 
-   %c Character, %d Integer, %s String, %% Percent
+   %c Character, %d or %i Integer, %s String, %% Percent
    %L  Takes locus argument
    %C  Current locus (no argument)
 
    If a locus pointer is given, the actual source line is printed out
    and the column is indicated.  Since we want the error message at
    the bottom of any source file information, we must scan the
-   argument list twice.  A maximum of two locus arguments are
-   permitted.  */
+   argument list twice -- once to determine whether the loci are 
+   present and record this for printing, and once to print the error
+   message after and loci have been printed.  A maximum of two locus
+   arguments are permitted.
+   
+   This function is also called (recursively) by show_locus in the
+   case of included files; however, as show_locus does not resupply
+   any loci, the recursion is at most one level deep.  */
 
-#define IBUF_LEN 30
 #define MAX_ARGS 10
 
 static void ATTRIBUTE_GCC_GFC(2,0)
 error_print (const char *type, const char *format0, va_list argp)
 {
-  char c, *p, int_buf[IBUF_LEN], c_arg[MAX_ARGS], *cp_arg[MAX_ARGS];
-  int i, n, have_l1, i_arg[MAX_ARGS];
+  enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
+         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
+        NOTYPE };
+  struct
+  {
+    int type;
+    int pos;
+    union
+    {
+      int intval;
+      unsigned int uintval;
+      long int longintval;
+      unsigned long int ulongintval;
+      char charval;
+      const char * stringval;
+    } u;
+  } arg[MAX_ARGS], spec[MAX_ARGS];
+  /* spec is the array of specifiers, in the same order as they
+     appear in the format string.  arg is the array of arguments,
+     in the same order as they appear in the va_list.  */
+
+  char c;
+  int i, n, have_l1, pos, maxpos;
   locus *l1, *l2, *loc;
   const char *format;
 
-  l1 = l2 = loc = NULL;
+  l1 = l2 = NULL;
 
   have_l1 = 0;
+  pos = -1;
+  maxpos = -1;
 
   n = 0;
   format = format0;
 
+  for (i = 0; i < MAX_ARGS; i++)
+    {
+      arg[i].type = NOTYPE;
+      spec[i].pos = -1;
+    }
+
+  /* First parse the format string for position specifiers.  */
   while (*format)
     {
       c = *format++;
-      if (c == '%')
+      if (c != '%')
+       continue;
+
+      if (*format == '%')
        {
-         c = *format++;
+         format++;
+         continue;
+       }
 
-         switch (c)
-           {
-           case '%':
-             break;
+      if (ISDIGIT (*format))
+       {
+         /* This is a position specifier.  For example, the number
+            12 in the format string "%12$d", which specifies the third
+            argument of the va_list, formatted in %d format.
+            For details, see "man 3 printf".  */
+         pos = atoi(format) - 1;
+         gcc_assert (pos >= 0);
+         while (ISDIGIT(*format))
+           format++;
+         gcc_assert (*format++ == '$');
+       }
+      else
+       pos++;
+
+      c = *format++;
+
+      if (pos > maxpos)
+       maxpos = pos;
+
+      switch (c)
+       {
+         case 'C':
+           arg[pos].type = TYPE_CURRENTLOC;
+           break;
+
+         case 'L':
+           arg[pos].type = TYPE_LOCUS;
+           break;
+
+         case 'd':
+         case 'i':
+           arg[pos].type = TYPE_INTEGER;
+           break;
+
+         case 'u':
+           arg[pos].type = TYPE_UINTEGER;
+
+         case 'l':
+           c = *format++;
+           if (c == 'u')
+             arg[pos].type = TYPE_ULONGINT;
+           else if (c == 'i' || c == 'd')
+             arg[pos].type = TYPE_LONGINT;
+           else
+             gcc_unreachable ();
+           break;
+
+         case 'c':
+           arg[pos].type = TYPE_CHAR;
+           break;
+
+         case 's':
+           arg[pos].type = TYPE_STRING;
+           break;
+
+         default:
+           gcc_unreachable ();
+       }
+
+      spec[n++].pos = pos;
+    }
+
+  /* Then convert the values for each %-style argument.  */
+  for (pos = 0; pos <= maxpos; pos++)
+    {
+      gcc_assert (arg[pos].type != NOTYPE);
+      switch (arg[pos].type)
+       {
+         case TYPE_CURRENTLOC:
+           loc = &gfc_current_locus;
+           /* Fall through.  */
 
-           case 'L':
+         case TYPE_LOCUS:
+           if (arg[pos].type == TYPE_LOCUS)
              loc = va_arg (argp, locus *);
-             /* Fall through */
-
-           case 'C':
-             if (c == 'C')
-               loc = &gfc_current_locus;
-
-             if (have_l1)
-               {
-                 l2 = loc;
-               }
-             else
-               {
-                 l1 = loc;
-                 have_l1 = 1;
-               }
-             break;
-
-           case 'd':
-           case 'i':
-             i_arg[n++] = va_arg (argp, int);
-             break;
-
-           case 'c':
-             c_arg[n++] = va_arg (argp, int);
-             break;
-
-           case 's':
-             cp_arg[n++] = va_arg (argp, char *);
-             break;
-           }
+
+           if (have_l1)
+             {
+               l2 = loc;
+               arg[pos].u.stringval = "(2)";
+             }
+           else
+             {
+               l1 = loc;
+               have_l1 = 1;
+               arg[pos].u.stringval = "(1)";
+             }
+           break;
+
+         case TYPE_INTEGER:
+           arg[pos].u.intval = va_arg (argp, int);
+           break;
+
+         case TYPE_UINTEGER:
+           arg[pos].u.uintval = va_arg (argp, unsigned int);
+           break;
+
+         case TYPE_LONGINT:
+           arg[pos].u.longintval = va_arg (argp, long int);
+           break;
+
+         case TYPE_ULONGINT:
+           arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
+           break;
+
+         case TYPE_CHAR:
+           arg[pos].u.charval = (char) va_arg (argp, int);
+           break;
+
+         case TYPE_STRING:
+           arg[pos].u.stringval = (const char *) va_arg (argp, char *);
+           break;
+
+         default:
+           gcc_unreachable ();
        }
     }
 
+  for (n = 0; spec[n].pos >= 0; n++)
+    spec[n].u = arg[spec[n].pos].u;
+
   /* Show the current loci if we have to.  */
   if (have_l1)
     show_loci (l1, l2);
-  error_string (type);
+
   if (*type)
-    error_char (' ');
+    {
+      error_string (type);
+      error_char (' ');
+    }
 
   have_l1 = 0;
   format = format0;
@@ -396,6 +577,16 @@ error_print (const char *type, const char *format0, va_list argp)
        }
 
       format++;
+      if (ISDIGIT (*format))
+       {
+         /* This is a position specifier.  See comment above.  */
+         while (ISDIGIT (*format))
+           format++;
+           
+         /* Skip over the dollar sign.  */
+         format++;
+       }
+       
       switch (*format)
        {
        case '%':
@@ -403,43 +594,32 @@ error_print (const char *type, const char *format0, va_list argp)
          break;
 
        case 'c':
-         error_char (c_arg[n++]);
+         error_char (spec[n++].u.charval);
          break;
 
        case 's':
-         error_string (cp_arg[n++]);
+       case 'C':               /* Current locus */
+       case 'L':               /* Specified locus */
+         error_string (spec[n++].u.stringval);
          break;
 
-       case 'i':
        case 'd':
-         i = i_arg[n++];
-
-         if (i < 0)
-           {
-             i = -i;
-             error_char ('-');
-           }
-
-         p = int_buf + IBUF_LEN - 1;
-         *p-- = '\0';
-
-         if (i == 0)
-           *p-- = '0';
-
-         while (i > 0)
-           {
-             *p-- = i % 10 + '0';
-             i = i / 10;
-           }
+       case 'i':
+         error_integer (spec[n++].u.intval);
+         break;
 
-         error_string (p + 1);
+       case 'u':
+         error_uinteger (spec[n++].u.uintval);
          break;
 
-       case 'C':               /* Current locus */
-       case 'L':               /* Specified locus */
-         error_string (have_l1 ? "(2)" : "(1)");
-         have_l1 = 1;
+       case 'l':
+         format++;
+         if (*format == 'u')
+           error_uinteger (spec[n++].u.ulongintval);
+         else
+           error_integer (spec[n++].u.longintval);
          break;
+
        }
     }
 
@@ -460,6 +640,18 @@ error_printf (const char *nocmsgid, ...)
 }
 
 
+/* Increment the number of errors, and check whether too many have 
+   been printed.  */
+
+static void
+gfc_increment_error_count (void)
+{
+  errors++;
+  if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
+    gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
+}
+
+
 /* Issue a warning.  */
 
 void
@@ -475,17 +667,17 @@ gfc_warning (const char *nocmsgid, ...)
   cur_error_buffer = &warning_buffer;
 
   va_start (argp, nocmsgid);
+  error_print (_("Warning:"), _(nocmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
   if (buffer_flag == 0)
   {
     warnings++;
     if (warnings_are_errors)
-      errors++;
+      gfc_increment_error_count();
   }
-
-  error_print (_("Warning:"), _(nocmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
 }
 
 
@@ -516,27 +708,18 @@ gfc_notify_std (int std, const char *nocmsgid, ...)
   va_list argp;
   bool warning;
 
-  warning = ((gfc_option.warn_std & std) != 0)
-           && !inhibit_warnings;
-  if ((gfc_option.allow_std & std) != 0
-      && !warning)
+  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+  if ((gfc_option.allow_std & std) != 0 && !warning)
     return SUCCESS;
 
   if (gfc_suppress_error)
     return warning ? SUCCESS : FAILURE;
 
   cur_error_buffer = (warning && !warnings_are_errors)
-    ? &warning_buffer : &error_buffer;
+                  ? &warning_buffer : &error_buffer;
   cur_error_buffer->flag = 1;
   cur_error_buffer->index = 0;
 
-  if (buffer_flag == 0)
-    {
-      if (warning && !warnings_are_errors)
-       warnings++;
-      else
-       errors++;
-    }
   va_start (argp, nocmsgid);
   if (warning)
     error_print (_("Warning:"), _(nocmsgid), argp);
@@ -545,6 +728,15 @@ gfc_notify_std (int std, const char *nocmsgid, ...)
   va_end (argp);
 
   error_char ('\0');
+
+  if (buffer_flag == 0)
+    {
+      if (warning && !warnings_are_errors)
+       warnings++;
+      else
+       gfc_increment_error_count();
+    }
+
   return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
 }
 
@@ -564,7 +756,7 @@ gfc_warning_now (const char *nocmsgid, ...)
   buffer_flag = 0;
   warnings++;
   if (warnings_are_errors)
-    errors++;
+    gfc_increment_error_count();
 
   va_start (argp, nocmsgid);
   error_print (_("Warning:"), _(nocmsgid), argp);
@@ -615,12 +807,13 @@ gfc_error (const char *nocmsgid, ...)
   cur_error_buffer = &error_buffer;
 
   va_start (argp, nocmsgid);
-  if (buffer_flag == 0)
-    errors++;
   error_print (_("Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
+
+  if (buffer_flag == 0)
+    gfc_increment_error_count();
 }
 
 
@@ -638,13 +831,15 @@ gfc_error_now (const char *nocmsgid, ...)
 
   i = buffer_flag;
   buffer_flag = 0;
-  errors++;
 
   va_start (argp, nocmsgid);
   error_print (_("Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
+
+  gfc_increment_error_count();
+
   buffer_flag = i;
 
   if (flag_fatal_errors)
@@ -699,6 +894,15 @@ gfc_clear_error (void)
 }
 
 
+/* Tests the state of error_flag.  */
+
+int
+gfc_error_flag_test (void)
+{
+  return error_buffer.flag;
+}
+
+
 /* Check to see if any errors have been saved.
    If so, print the error.  Returns the state of error_flag.  */
 
@@ -711,11 +915,12 @@ gfc_error_check (void)
 
   if (error_buffer.flag)
     {
-      errors++;
       if (error_buffer.message != NULL)
        fputs (error_buffer.message, stderr);
       error_buffer.flag = 0;
 
+      gfc_increment_error_count();
+
       if (flag_fatal_errors)
        exit (1);
     }
@@ -727,7 +932,7 @@ gfc_error_check (void)
 /* Save the existing error state.  */
 
 void
-gfc_push_error (gfc_error_buf * err)
+gfc_push_error (gfc_error_buf *err)
 {
   err->flag = error_buffer.flag;
   if (error_buffer.flag)
@@ -740,7 +945,7 @@ gfc_push_error (gfc_error_buf * err)
 /* Restore a previous pushed error state.  */
 
 void
-gfc_pop_error (gfc_error_buf * err)
+gfc_pop_error (gfc_error_buf *err)
 {
   error_buffer.flag = err->flag;
   if (error_buffer.flag)
@@ -756,7 +961,7 @@ gfc_pop_error (gfc_error_buf * err)
 /* Free a pushed error state, but keep the current error state.  */
 
 void
-gfc_free_error (gfc_error_buf * err)
+gfc_free_error (gfc_error_buf *err)
 {
   if (err->flag)
     gfc_free (err->message);