LCOV - code coverage report
Current view: top level - gcc/fortran - error.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 59.2 % 764 452
Test Date: 2024-07-13 14:16:58 Functions: 74.1 % 58 43
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* Handle errors.
       2                 :             :    Copyright (C) 2000-2024 Free Software Foundation, Inc.
       3                 :             :    Contributed by Andy Vaught & Niels Kristian Bech Jensen
       4                 :             : 
       5                 :             : This file is part of GCC.
       6                 :             : 
       7                 :             : GCC is free software; you can redistribute it and/or modify it under
       8                 :             : the terms of the GNU General Public License as published by the Free
       9                 :             : Software Foundation; either version 3, or (at your option) any later
      10                 :             : version.
      11                 :             : 
      12                 :             : GCC is distributed in the hope that it will be useful, but WITHOUT ANY
      13                 :             : WARRANTY; without even the implied warranty of MERCHANTABILITY or
      14                 :             : FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
      15                 :             : for more details.
      16                 :             : 
      17                 :             : You should have received a copy of the GNU General Public License
      18                 :             : along with GCC; see the file COPYING3.  If not see
      19                 :             : <http://www.gnu.org/licenses/>.  */
      20                 :             : 
      21                 :             : /* Handle the inevitable errors.  A major catch here is that things
      22                 :             :    flagged as errors in one match subroutine can conceivably be legal
      23                 :             :    elsewhere.  This means that error messages are recorded and saved
      24                 :             :    for possible use later.  If a line does not match a legal
      25                 :             :    construction, then the saved error message is reported.  */
      26                 :             : 
      27                 :             : #include "config.h"
      28                 :             : #include "system.h"
      29                 :             : #include "coretypes.h"
      30                 :             : #include "options.h"
      31                 :             : #include "gfortran.h"
      32                 :             : 
      33                 :             : #include "diagnostic.h"
      34                 :             : #include "diagnostic-color.h"
      35                 :             : #include "tree-diagnostic.h" /* tree_diagnostics_defaults */
      36                 :             : 
      37                 :             : static int suppress_errors = 0;
      38                 :             : 
      39                 :             : static bool warnings_not_errors = false;
      40                 :             : 
      41                 :             : static int terminal_width;
      42                 :             : 
      43                 :             : /* True if the error/warnings should be buffered.  */
      44                 :             : static bool buffered_p;
      45                 :             : 
      46                 :             : static gfc_error_buffer error_buffer;
      47                 :             : /* These are always buffered buffers (.flush_p == false) to be used by
      48                 :             :    the pretty-printer.  */
      49                 :             : static output_buffer *pp_error_buffer, *pp_warning_buffer;
      50                 :             : static int warningcount_buffered, werrorcount_buffered;
      51                 :             : 
      52                 :             : /* Return buffered_p.  */
      53                 :             : bool
      54                 :          73 : gfc_buffered_p (void)
      55                 :             : {
      56                 :          73 :   return buffered_p;
      57                 :             : }
      58                 :             : 
      59                 :             : /* Return true if there output_buffer is empty.  */
      60                 :             : 
      61                 :             : static bool
      62                 :     5380746 : gfc_output_buffer_empty_p (const output_buffer * buf)
      63                 :             : {
      64                 :           0 :   return output_buffer_last_position_in_text (buf) == NULL;
      65                 :             : }
      66                 :             : 
      67                 :             : /* Go one level deeper suppressing errors.  */
      68                 :             : 
      69                 :             : void
      70                 :      406347 : gfc_push_suppress_errors (void)
      71                 :             : {
      72                 :      406347 :   gcc_assert (suppress_errors >= 0);
      73                 :      406347 :   ++suppress_errors;
      74                 :      406347 : }
      75                 :             : 
      76                 :             : static void
      77                 :             : gfc_error_opt (int opt, const char *gmsgid, va_list ap)  ATTRIBUTE_GCC_GFC(2,0);
      78                 :             : 
      79                 :             : static bool
      80                 :             : gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
      81                 :             : 
      82                 :             : 
      83                 :             : /* Leave one level of error suppressing.  */
      84                 :             : 
      85                 :             : void
      86                 :      406347 : gfc_pop_suppress_errors (void)
      87                 :             : {
      88                 :      406347 :   gcc_assert (suppress_errors > 0);
      89                 :      406347 :   --suppress_errors;
      90                 :      406347 : }
      91                 :             : 
      92                 :             : 
      93                 :             : /* Query whether errors are suppressed.  */
      94                 :             : 
      95                 :             : bool
      96                 :         139 : gfc_query_suppress_errors (void)
      97                 :             : {
      98                 :         139 :   return suppress_errors > 0;
      99                 :             : }
     100                 :             : 
     101                 :             : 
     102                 :             : /* Determine terminal width (for trimming source lines in output).  */
     103                 :             : 
     104                 :             : static int
     105                 :       29874 : gfc_get_terminal_width (void)
     106                 :             : {
     107                 :       29874 :   return isatty (STDERR_FILENO) ? get_terminal_width () : INT_MAX;
     108                 :             : }
     109                 :             : 
     110                 :             : 
     111                 :             : /* Per-file error initialization.  */
     112                 :             : 
     113                 :             : void
     114                 :       29874 : gfc_error_init_1 (void)
     115                 :             : {
     116                 :       29874 :   terminal_width = gfc_get_terminal_width ();
     117                 :       29874 :   gfc_buffer_error (false);
     118                 :       29874 : }
     119                 :             : 
     120                 :             : 
     121                 :             : /* Set the flag for buffering errors or not.  */
     122                 :             : 
     123                 :             : void
     124                 :     5717166 : gfc_buffer_error (bool flag)
     125                 :             : {
     126                 :     5717166 :   buffered_p = flag;
     127                 :     5717166 : }
     128                 :             : 
     129                 :             : 
     130                 :             : /* Add a single character to the error buffer or output depending on
     131                 :             :    buffered_p.  */
     132                 :             : 
     133                 :             : static void
     134                 :           0 : error_char (char)
     135                 :             : {
     136                 :             :   /* FIXME: Unused function to be removed in a subsequent patch.  */
     137                 :           0 : }
     138                 :             : 
     139                 :             : 
     140                 :             : /* Copy a string to wherever it needs to go.  */
     141                 :             : 
     142                 :             : static void
     143                 :           0 : error_string (const char *p)
     144                 :             : {
     145                 :           0 :   while (*p)
     146                 :             :     error_char (*p++);
     147                 :           0 : }
     148                 :             : 
     149                 :             : 
     150                 :             : /* Print a formatted integer to the error buffer or output.  */
     151                 :             : 
     152                 :             : #define IBUF_LEN 60
     153                 :             : 
     154                 :             : static void
     155                 :           0 : error_uinteger (unsigned long long int i)
     156                 :             : {
     157                 :           0 :   char *p, int_buf[IBUF_LEN];
     158                 :             : 
     159                 :           0 :   p = int_buf + IBUF_LEN - 1;
     160                 :           0 :   *p-- = '\0';
     161                 :             : 
     162                 :           0 :   if (i == 0)
     163                 :             :     *p-- = '0';
     164                 :             : 
     165                 :           0 :   while (i > 0)
     166                 :             :     {
     167                 :             :       *p-- = i % 10 + '0';
     168                 :             :       i = i / 10;
     169                 :             :     }
     170                 :             : 
     171                 :           0 :   error_string (p + 1);
     172                 :           0 : }
     173                 :             : 
     174                 :             : static void
     175                 :           0 : error_integer (long long int i)
     176                 :             : {
     177                 :           0 :   unsigned long long int u;
     178                 :             : 
     179                 :           0 :   if (i < 0)
     180                 :             :     {
     181                 :             :       u = (unsigned long long int) -i;
     182                 :             :       error_char ('-');
     183                 :             :     }
     184                 :             :   else
     185                 :           0 :     u = i;
     186                 :             : 
     187                 :           0 :   error_uinteger (u);
     188                 :           0 : }
     189                 :             : 
     190                 :             : 
     191                 :             : static void
     192                 :           0 : error_hwuint (unsigned HOST_WIDE_INT i)
     193                 :             : {
     194                 :           0 :   char *p, int_buf[IBUF_LEN];
     195                 :             : 
     196                 :           0 :   p = int_buf + IBUF_LEN - 1;
     197                 :           0 :   *p-- = '\0';
     198                 :             : 
     199                 :           0 :   if (i == 0)
     200                 :             :     *p-- = '0';
     201                 :             : 
     202                 :           0 :   while (i > 0)
     203                 :             :     {
     204                 :             :       *p-- = i % 10 + '0';
     205                 :             :       i = i / 10;
     206                 :             :     }
     207                 :             : 
     208                 :           0 :   error_string (p + 1);
     209                 :           0 : }
     210                 :             : 
     211                 :             : static void
     212                 :           0 : error_hwint (HOST_WIDE_INT i)
     213                 :             : {
     214                 :           0 :   unsigned HOST_WIDE_INT u;
     215                 :             : 
     216                 :           0 :   if (i < 0)
     217                 :             :     {
     218                 :             :       u = (unsigned HOST_WIDE_INT) -i;
     219                 :             :       error_char ('-');
     220                 :             :     }
     221                 :             :   else
     222                 :           0 :     u = i;
     223                 :             : 
     224                 :           0 :   error_uinteger (u);
     225                 :           0 : }
     226                 :             : 
     227                 :             : 
     228                 :             : static size_t
     229                 :           0 : gfc_widechar_display_length (gfc_char_t c)
     230                 :             : {
     231                 :           0 :   if (gfc_wide_is_printable (c) || c == '\t')
     232                 :             :     /* Printable ASCII character, or tabulation (output as a space).  */
     233                 :             :     return 1;
     234                 :           0 :   else if (c < ((gfc_char_t) 1 << 8))
     235                 :             :     /* Displayed as \x??  */
     236                 :             :     return 4;
     237                 :           0 :   else if (c < ((gfc_char_t) 1 << 16))
     238                 :             :     /* Displayed as \u????  */
     239                 :             :     return 6;
     240                 :             :   else
     241                 :             :     /* Displayed as \U????????  */
     242                 :           0 :     return 10;
     243                 :             : }
     244                 :             : 
     245                 :             : 
     246                 :             : /* Length of the ASCII representation of the wide string, escaping wide
     247                 :             :    characters as print_wide_char_into_buffer() does.  */
     248                 :             : 
     249                 :             : static size_t
     250                 :           0 : gfc_wide_display_length (const gfc_char_t *str)
     251                 :             : {
     252                 :           0 :   size_t i, len;
     253                 :             : 
     254                 :           0 :   for (i = 0, len = 0; str[i]; i++)
     255                 :           0 :     len += gfc_widechar_display_length (str[i]);
     256                 :             : 
     257                 :           0 :   return len;
     258                 :             : }
     259                 :             : 
     260                 :             : static int
     261                 :          25 : print_wide_char_into_buffer (gfc_char_t c, char *buf)
     262                 :             : {
     263                 :          25 :   static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
     264                 :             :     '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
     265                 :             : 
     266                 :          25 :   if (gfc_wide_is_printable (c) || c == '\t')
     267                 :             :     {
     268                 :           2 :       buf[1] = '\0';
     269                 :             :       /* Tabulation is output as a space.  */
     270                 :           2 :       buf[0] = (unsigned char) (c == '\t' ? ' ' : c);
     271                 :           2 :       return 1;
     272                 :             :     }
     273                 :          23 :   else if (c < ((gfc_char_t) 1 << 8))
     274                 :             :     {
     275                 :          14 :       buf[4] = '\0';
     276                 :          14 :       buf[3] = xdigit[c & 0x0F];
     277                 :          14 :       c = c >> 4;
     278                 :          14 :       buf[2] = xdigit[c & 0x0F];
     279                 :             : 
     280                 :          14 :       buf[1] = 'x';
     281                 :          14 :       buf[0] = '\\';
     282                 :          14 :       return 4;
     283                 :             :     }
     284                 :           9 :   else if (c < ((gfc_char_t) 1 << 16))
     285                 :             :     {
     286                 :           8 :       buf[6] = '\0';
     287                 :           8 :       buf[5] = xdigit[c & 0x0F];
     288                 :           8 :       c = c >> 4;
     289                 :           8 :       buf[4] = xdigit[c & 0x0F];
     290                 :           8 :       c = c >> 4;
     291                 :           8 :       buf[3] = xdigit[c & 0x0F];
     292                 :           8 :       c = c >> 4;
     293                 :           8 :       buf[2] = xdigit[c & 0x0F];
     294                 :             : 
     295                 :           8 :       buf[1] = 'u';
     296                 :           8 :       buf[0] = '\\';
     297                 :           8 :       return 6;
     298                 :             :     }
     299                 :             :   else
     300                 :             :     {
     301                 :           1 :       buf[10] = '\0';
     302                 :           1 :       buf[9] = xdigit[c & 0x0F];
     303                 :           1 :       c = c >> 4;
     304                 :           1 :       buf[8] = xdigit[c & 0x0F];
     305                 :           1 :       c = c >> 4;
     306                 :           1 :       buf[7] = xdigit[c & 0x0F];
     307                 :           1 :       c = c >> 4;
     308                 :           1 :       buf[6] = xdigit[c & 0x0F];
     309                 :           1 :       c = c >> 4;
     310                 :           1 :       buf[5] = xdigit[c & 0x0F];
     311                 :           1 :       c = c >> 4;
     312                 :           1 :       buf[4] = xdigit[c & 0x0F];
     313                 :           1 :       c = c >> 4;
     314                 :           1 :       buf[3] = xdigit[c & 0x0F];
     315                 :           1 :       c = c >> 4;
     316                 :           1 :       buf[2] = xdigit[c & 0x0F];
     317                 :             : 
     318                 :           1 :       buf[1] = 'U';
     319                 :           1 :       buf[0] = '\\';
     320                 :           1 :       return 10;
     321                 :             :     }
     322                 :             : }
     323                 :             : 
     324                 :             : static char wide_char_print_buffer[11];
     325                 :             : 
     326                 :             : const char *
     327                 :          25 : gfc_print_wide_char (gfc_char_t c)
     328                 :             : {
     329                 :          25 :   print_wide_char_into_buffer (c, wide_char_print_buffer);
     330                 :          25 :   return wide_char_print_buffer;
     331                 :             : }
     332                 :             : 
     333                 :             : 
     334                 :             : /* Show the file, where it was included, and the source line, give a
     335                 :             :    locus.  Calls error_printf() recursively, but the recursion is at
     336                 :             :    most one level deep.  */
     337                 :             : 
     338                 :             : static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
     339                 :             : 
     340                 :             : static void
     341                 :           0 : show_locus (locus *loc, int c1, int c2)
     342                 :             : {
     343                 :           0 :   gfc_linebuf *lb;
     344                 :           0 :   gfc_file *f;
     345                 :           0 :   gfc_char_t *p;
     346                 :           0 :   int i, offset, cmax;
     347                 :             : 
     348                 :             :   /* TODO: Either limit the total length and number of included files
     349                 :             :      displayed or add buffering of arbitrary number of characters in
     350                 :             :      error messages.  */
     351                 :             : 
     352                 :             :   /* Write out the error header line, giving the source file and error
     353                 :             :      location (in GNU standard "[file]:[line].[column]:" format),
     354                 :             :      followed by an "included by" stack and a blank line.  This header
     355                 :             :      format is matched by a testsuite parser defined in
     356                 :             :      lib/gfortran-dg.exp.  */
     357                 :             : 
     358                 :           0 :   lb = loc->lb;
     359                 :           0 :   f = lb->file;
     360                 :             : 
     361                 :           0 :   error_string (f->filename);
     362                 :           0 :   error_char (':');
     363                 :             : 
     364                 :           0 :   error_integer (LOCATION_LINE (lb->location));
     365                 :             : 
     366                 :           0 :   if ((c1 > 0) || (c2 > 0))
     367                 :           0 :     error_char ('.');
     368                 :             : 
     369                 :           0 :   if (c1 > 0)
     370                 :             :     error_integer (c1);
     371                 :             : 
     372                 :           0 :   if ((c1 > 0) && (c2 > 0))
     373                 :           0 :     error_char ('-');
     374                 :             : 
     375                 :           0 :   if (c2 > 0)
     376                 :             :     error_integer (c2);
     377                 :             : 
     378                 :             :   error_char (':');
     379                 :             :   error_char ('\n');
     380                 :             : 
     381                 :           0 :   for (;;)
     382                 :             :     {
     383                 :           0 :       i = f->inclusion_line;
     384                 :             : 
     385                 :           0 :       f = f->up;
     386                 :           0 :       if (f == NULL) break;
     387                 :             : 
     388                 :           0 :       error_printf ("    Included at %s:%d:", f->filename, i);
     389                 :             :     }
     390                 :             : 
     391                 :           0 :   error_char ('\n');
     392                 :             : 
     393                 :             :   /* Calculate an appropriate horizontal offset of the source line in
     394                 :             :      order to get the error locus within the visible portion of the
     395                 :             :      line.  Note that if the margin of 5 here is changed, the
     396                 :             :      corresponding margin of 10 in show_loci should be changed.  */
     397                 :             : 
     398                 :           0 :   offset = 0;
     399                 :             : 
     400                 :             :   /* If the two loci would appear in the same column, we shift
     401                 :             :      '2' one column to the right, so as to print '12' rather than
     402                 :             :      just '1'.  We do this here so it will be accounted for in the
     403                 :             :      margin calculations.  */
     404                 :             : 
     405                 :           0 :   if (c1 == c2)
     406                 :           0 :     c2 += 1;
     407                 :             : 
     408                 :           0 :   cmax = (c1 < c2) ? c2 : c1;
     409                 :           0 :   if (cmax > terminal_width - 5)
     410                 :           0 :     offset = cmax - terminal_width + 5;
     411                 :             : 
     412                 :             :   /* Show the line itself, taking care not to print more than what can
     413                 :             :      show up on the terminal.  Tabs are converted to spaces, and
     414                 :             :      nonprintable characters are converted to a "\xNN" sequence.  */
     415                 :             : 
     416                 :           0 :   p = &(lb->line[offset]);
     417                 :           0 :   i = gfc_wide_display_length (p);
     418                 :           0 :   if (i > terminal_width)
     419                 :           0 :     i = terminal_width - 1;
     420                 :             : 
     421                 :           0 :   while (i > 0)
     422                 :             :     {
     423                 :           0 :       static char buffer[11];
     424                 :           0 :       i -= print_wide_char_into_buffer (*p++, buffer);
     425                 :           0 :       error_string (buffer);
     426                 :             :     }
     427                 :             : 
     428                 :           0 :   error_char ('\n');
     429                 :             : 
     430                 :             :   /* Show the '1' and/or '2' corresponding to the column of the error
     431                 :             :      locus.  Note that a value of -1 for c1 or c2 will simply cause
     432                 :             :      the relevant number not to be printed.  */
     433                 :             : 
     434                 :           0 :   c1 -= offset;
     435                 :           0 :   c2 -= offset;
     436                 :           0 :   cmax -= offset;
     437                 :             : 
     438                 :           0 :   p = &(lb->line[offset]);
     439                 :           0 :   for (i = 0; i < cmax; i++)
     440                 :             :     {
     441                 :           0 :       int spaces, j;
     442                 :           0 :       spaces = gfc_widechar_display_length (*p++);
     443                 :             : 
     444                 :           0 :       if (i == c1)
     445                 :             :         error_char ('1'), spaces--;
     446                 :           0 :       else if (i == c2)
     447                 :             :         error_char ('2'), spaces--;
     448                 :             : 
     449                 :           0 :       for (j = 0; j < spaces; j++)
     450                 :             :         error_char (' ');
     451                 :             :     }
     452                 :             : 
     453                 :           0 :   if (i == c1)
     454                 :             :     error_char ('1');
     455                 :           0 :   else if (i == c2)
     456                 :           0 :     error_char ('2');
     457                 :             : 
     458                 :           0 :   error_char ('\n');
     459                 :             : 
     460                 :           0 : }
     461                 :             : 
     462                 :             : 
     463                 :             : /* As part of printing an error, we show the source lines that caused
     464                 :             :    the problem.  We show at least one, and possibly two loci; the two
     465                 :             :    loci may or may not be on the same source line.  */
     466                 :             : 
     467                 :             : static void
     468                 :           0 : show_loci (locus *l1, locus *l2)
     469                 :             : {
     470                 :           0 :   int m, c1, c2;
     471                 :             : 
     472                 :           0 :   if (l1 == NULL || l1->lb == NULL)
     473                 :             :     {
     474                 :           0 :       error_printf ("<During initialization>\n");
     475                 :           0 :       return;
     476                 :             :     }
     477                 :             : 
     478                 :             :   /* While calculating parameters for printing the loci, we consider possible
     479                 :             :      reasons for printing one per line.  If appropriate, print the loci
     480                 :             :      individually; otherwise we print them both on the same line.  */
     481                 :             : 
     482                 :           0 :   c1 = l1->nextc - l1->lb->line;
     483                 :           0 :   if (l2 == NULL)
     484                 :             :     {
     485                 :           0 :       show_locus (l1, c1, -1);
     486                 :           0 :       return;
     487                 :             :     }
     488                 :             : 
     489                 :           0 :   c2 = l2->nextc - l2->lb->line;
     490                 :             : 
     491                 :           0 :   if (c1 < c2)
     492                 :           0 :     m = c2 - c1;
     493                 :             :   else
     494                 :           0 :     m = c1 - c2;
     495                 :             : 
     496                 :             :   /* Note that the margin value of 10 here needs to be less than the
     497                 :             :      margin of 5 used in the calculation of offset in show_locus.  */
     498                 :             : 
     499                 :           0 :   if (l1->lb != l2->lb || m > terminal_width - 10)
     500                 :             :     {
     501                 :           0 :       show_locus (l1, c1, -1);
     502                 :           0 :       show_locus (l2, -1, c2);
     503                 :           0 :       return;
     504                 :             :     }
     505                 :             : 
     506                 :           0 :   show_locus (l1, c1, c2);
     507                 :             : 
     508                 :           0 :   return;
     509                 :             : }
     510                 :             : 
     511                 :             : 
     512                 :             : /* Workhorse for the error printing subroutines.  This subroutine is
     513                 :             :    inspired by g77's error handling and is similar to printf() with
     514                 :             :    the following %-codes:
     515                 :             : 
     516                 :             :    %c Character, %d or %i Integer, %s String, %% Percent
     517                 :             :    %L  Takes locus argument
     518                 :             :    %C  Current locus (no argument)
     519                 :             : 
     520                 :             :    If a locus pointer is given, the actual source line is printed out
     521                 :             :    and the column is indicated.  Since we want the error message at
     522                 :             :    the bottom of any source file information, we must scan the
     523                 :             :    argument list twice -- once to determine whether the loci are
     524                 :             :    present and record this for printing, and once to print the error
     525                 :             :    message after and loci have been printed.  A maximum of two locus
     526                 :             :    arguments are permitted.
     527                 :             : 
     528                 :             :    This function is also called (recursively) by show_locus in the
     529                 :             :    case of included files; however, as show_locus does not resupply
     530                 :             :    any loci, the recursion is at most one level deep.  */
     531                 :             : 
     532                 :             : #define MAX_ARGS 10
     533                 :             : 
     534                 :             : static void ATTRIBUTE_GCC_GFC(2,0)
     535                 :           0 : error_print (const char *type, const char *format0, va_list argp)
     536                 :             : {
     537                 :           0 :   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
     538                 :             :          TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
     539                 :             :          TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, TYPE_SIZE,
     540                 :             :          TYPE_SSIZE, TYPE_PTRDIFF, NOTYPE };
     541                 :           0 :   struct
     542                 :             :   {
     543                 :             :     int type;
     544                 :             :     int pos;
     545                 :             :     union
     546                 :             :     {
     547                 :             :       int intval;
     548                 :             :       unsigned int uintval;
     549                 :             :       long int longintval;
     550                 :             :       unsigned long int ulongintval;
     551                 :             :       long long int llongintval;
     552                 :             :       unsigned long long int ullongintval;
     553                 :             :       HOST_WIDE_INT hwintval;
     554                 :             :       unsigned HOST_WIDE_INT hwuintval;
     555                 :             :       char charval;
     556                 :             :       const char * stringval;
     557                 :             :       size_t sizeval;
     558                 :             :       ssize_t ssizeval;
     559                 :             :       ptrdiff_t ptrdiffval;
     560                 :             :     } u;
     561                 :             :   } arg[MAX_ARGS], spec[MAX_ARGS];
     562                 :             :   /* spec is the array of specifiers, in the same order as they
     563                 :             :      appear in the format string.  arg is the array of arguments,
     564                 :             :      in the same order as they appear in the va_list.  */
     565                 :             : 
     566                 :           0 :   char c;
     567                 :           0 :   int i, n, have_l1, pos, maxpos;
     568                 :           0 :   locus *l1, *l2, *loc;
     569                 :           0 :   const char *format;
     570                 :             : 
     571                 :           0 :   loc = l1 = l2 = NULL;
     572                 :             : 
     573                 :           0 :   have_l1 = 0;
     574                 :           0 :   pos = -1;
     575                 :           0 :   maxpos = -1;
     576                 :             : 
     577                 :           0 :   n = 0;
     578                 :           0 :   format = format0;
     579                 :             : 
     580                 :           0 :   for (i = 0; i < MAX_ARGS; i++)
     581                 :             :     {
     582                 :           0 :       arg[i].type = NOTYPE;
     583                 :           0 :       spec[i].pos = -1;
     584                 :             :     }
     585                 :             : 
     586                 :             :   /* First parse the format string for position specifiers.  */
     587                 :           0 :   while (*format)
     588                 :             :     {
     589                 :           0 :       c = *format++;
     590                 :           0 :       if (c != '%')
     591                 :           0 :         continue;
     592                 :             : 
     593                 :           0 :       if (*format == '%')
     594                 :             :         {
     595                 :           0 :           format++;
     596                 :           0 :           continue;
     597                 :             :         }
     598                 :             : 
     599                 :           0 :       if (ISDIGIT (*format))
     600                 :             :         {
     601                 :             :           /* This is a position specifier.  For example, the number
     602                 :             :              12 in the format string "%12$d", which specifies the third
     603                 :             :              argument of the va_list, formatted in %d format.
     604                 :             :              For details, see "man 3 printf".  */
     605                 :           0 :           pos = atoi(format) - 1;
     606                 :           0 :           gcc_assert (pos >= 0);
     607                 :           0 :           while (ISDIGIT(*format))
     608                 :           0 :             format++;
     609                 :           0 :           gcc_assert (*format == '$');
     610                 :           0 :           format++;
     611                 :             :         }
     612                 :             :       else
     613                 :           0 :         pos++;
     614                 :             : 
     615                 :           0 :       c = *format++;
     616                 :             : 
     617                 :           0 :       if (pos > maxpos)
     618                 :             :         maxpos = pos;
     619                 :             : 
     620                 :           0 :       switch (c)
     621                 :             :         {
     622                 :           0 :           case 'C':
     623                 :           0 :             arg[pos].type = TYPE_CURRENTLOC;
     624                 :           0 :             break;
     625                 :             : 
     626                 :           0 :           case 'L':
     627                 :           0 :             arg[pos].type = TYPE_LOCUS;
     628                 :           0 :             break;
     629                 :             : 
     630                 :           0 :           case 'd':
     631                 :           0 :           case 'i':
     632                 :           0 :             arg[pos].type = TYPE_INTEGER;
     633                 :           0 :             break;
     634                 :             : 
     635                 :           0 :           case 'u':
     636                 :           0 :             arg[pos].type = TYPE_UINTEGER;
     637                 :           0 :             break;
     638                 :             : 
     639                 :           0 :           case 'l':
     640                 :           0 :             c = *format++;
     641                 :           0 :             if (c == 'l')
     642                 :             :               {
     643                 :           0 :                 c = *format++;
     644                 :           0 :                 if (c == 'u')
     645                 :           0 :                   arg[pos].type = TYPE_ULLONGINT;
     646                 :           0 :                 else if (c == 'i' || c == 'd')
     647                 :           0 :                   arg[pos].type = TYPE_LLONGINT;
     648                 :             :                 else
     649                 :           0 :                   gcc_unreachable ();
     650                 :             :               }
     651                 :           0 :             else if (c == 'u')
     652                 :           0 :               arg[pos].type = TYPE_ULONGINT;
     653                 :           0 :             else if (c == 'i' || c == 'd')
     654                 :           0 :               arg[pos].type = TYPE_LONGINT;
     655                 :             :             else
     656                 :           0 :               gcc_unreachable ();
     657                 :             :             break;
     658                 :             : 
     659                 :           0 :           case 'w':
     660                 :           0 :             c = *format++;
     661                 :           0 :             if (c == 'u')
     662                 :           0 :               arg[pos].type = TYPE_HWUINT;
     663                 :           0 :             else if (c == 'i' || c == 'd')
     664                 :           0 :               arg[pos].type = TYPE_HWINT;
     665                 :             :             else
     666                 :           0 :               gcc_unreachable ();
     667                 :             :             break;
     668                 :             : 
     669                 :           0 :           case 'z':
     670                 :           0 :             c = *format++;
     671                 :           0 :             if (c == 'u')
     672                 :           0 :               arg[pos].type = TYPE_SIZE;
     673                 :           0 :             else if (c == 'i' || c == 'd')
     674                 :           0 :               arg[pos].type = TYPE_SSIZE;
     675                 :             :             else
     676                 :           0 :               gcc_unreachable ();
     677                 :             :             break;
     678                 :             : 
     679                 :           0 :           case 't':
     680                 :           0 :             c = *format++;
     681                 :           0 :             if (c == 'u' || c == 'i' || c == 'd')
     682                 :           0 :               arg[pos].type = TYPE_PTRDIFF;
     683                 :             :             else
     684                 :           0 :               gcc_unreachable ();
     685                 :           0 :             break;
     686                 :             : 
     687                 :           0 :           case 'c':
     688                 :           0 :             arg[pos].type = TYPE_CHAR;
     689                 :           0 :             break;
     690                 :             : 
     691                 :           0 :           case 's':
     692                 :           0 :             arg[pos].type = TYPE_STRING;
     693                 :           0 :             break;
     694                 :             : 
     695                 :           0 :           default:
     696                 :           0 :             gcc_unreachable ();
     697                 :             :         }
     698                 :             : 
     699                 :           0 :       spec[n++].pos = pos;
     700                 :             :     }
     701                 :             : 
     702                 :             :   /* Then convert the values for each %-style argument.  */
     703                 :           0 :   for (pos = 0; pos <= maxpos; pos++)
     704                 :             :     {
     705                 :           0 :       gcc_assert (arg[pos].type != NOTYPE);
     706                 :           0 :       switch (arg[pos].type)
     707                 :             :         {
     708                 :           0 :           case TYPE_CURRENTLOC:
     709                 :           0 :             loc = &gfc_current_locus;
     710                 :             :             /* Fall through.  */
     711                 :             : 
     712                 :           0 :           case TYPE_LOCUS:
     713                 :           0 :             if (arg[pos].type == TYPE_LOCUS)
     714                 :           0 :               loc = va_arg (argp, locus *);
     715                 :             : 
     716                 :           0 :             if (have_l1)
     717                 :             :               {
     718                 :           0 :                 l2 = loc;
     719                 :           0 :                 arg[pos].u.stringval = "(2)";
     720                 :             :                 /* Point %C first offending character not the last good one. */
     721                 :           0 :                 if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
     722                 :           0 :                   l2->nextc++;
     723                 :             :               }
     724                 :             :             else
     725                 :             :               {
     726                 :           0 :                 l1 = loc;
     727                 :           0 :                 have_l1 = 1;
     728                 :           0 :                 arg[pos].u.stringval = "(1)";
     729                 :             :                 /* Point %C first offending character not the last good one. */
     730                 :           0 :                 if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
     731                 :           0 :                   l1->nextc++;
     732                 :             :               }
     733                 :             :             break;
     734                 :             : 
     735                 :           0 :           case TYPE_INTEGER:
     736                 :           0 :             arg[pos].u.intval = va_arg (argp, int);
     737                 :           0 :             break;
     738                 :             : 
     739                 :           0 :           case TYPE_UINTEGER:
     740                 :           0 :             arg[pos].u.uintval = va_arg (argp, unsigned int);
     741                 :           0 :             break;
     742                 :             : 
     743                 :           0 :           case TYPE_LONGINT:
     744                 :           0 :             arg[pos].u.longintval = va_arg (argp, long int);
     745                 :           0 :             break;
     746                 :             : 
     747                 :           0 :           case TYPE_ULONGINT:
     748                 :           0 :             arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
     749                 :           0 :             break;
     750                 :             : 
     751                 :           0 :           case TYPE_LLONGINT:
     752                 :           0 :             arg[pos].u.llongintval = va_arg (argp, long long int);
     753                 :           0 :             break;
     754                 :             : 
     755                 :           0 :           case TYPE_ULLONGINT:
     756                 :           0 :             arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
     757                 :           0 :             break;
     758                 :             : 
     759                 :           0 :           case TYPE_HWINT:
     760                 :           0 :             arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
     761                 :           0 :             break;
     762                 :             : 
     763                 :           0 :           case TYPE_HWUINT:
     764                 :           0 :             arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
     765                 :           0 :             break;
     766                 :             : 
     767                 :           0 :           case TYPE_SSIZE:
     768                 :           0 :             arg[pos].u.ssizeval = va_arg (argp, ssize_t);
     769                 :           0 :             break;
     770                 :             : 
     771                 :           0 :           case TYPE_SIZE:
     772                 :           0 :             arg[pos].u.sizeval = va_arg (argp, size_t);
     773                 :           0 :             break;
     774                 :             : 
     775                 :           0 :           case TYPE_PTRDIFF:
     776                 :           0 :             arg[pos].u.ptrdiffval = va_arg (argp, ptrdiff_t);
     777                 :           0 :             break;
     778                 :             : 
     779                 :           0 :           case TYPE_CHAR:
     780                 :           0 :             arg[pos].u.charval = (char) va_arg (argp, int);
     781                 :           0 :             break;
     782                 :             : 
     783                 :           0 :           case TYPE_STRING:
     784                 :           0 :             arg[pos].u.stringval = (const char *) va_arg (argp, char *);
     785                 :           0 :             break;
     786                 :             : 
     787                 :           0 :           default:
     788                 :           0 :             gcc_unreachable ();
     789                 :             :         }
     790                 :             :     }
     791                 :             : 
     792                 :           0 :   for (n = 0; spec[n].pos >= 0; n++)
     793                 :             :     spec[n].u = arg[spec[n].pos].u;
     794                 :             : 
     795                 :             :   /* Show the current loci if we have to.  */
     796                 :           0 :   if (have_l1)
     797                 :           0 :     show_loci (l1, l2);
     798                 :             : 
     799                 :           0 :   if (*type)
     800                 :             :     {
     801                 :           0 :       error_string (type);
     802                 :           0 :       error_char (' ');
     803                 :             :     }
     804                 :             : 
     805                 :           0 :   have_l1 = 0;
     806                 :           0 :   format = format0;
     807                 :           0 :   n = 0;
     808                 :             : 
     809                 :           0 :   for (; *format; format++)
     810                 :             :     {
     811                 :             :       if (*format != '%')
     812                 :             :         {
     813                 :             :           error_char (*format);
     814                 :             :           continue;
     815                 :             :         }
     816                 :             : 
     817                 :             :       format++;
     818                 :             :       if (ISDIGIT (*format))
     819                 :             :         {
     820                 :             :           /* This is a position specifier.  See comment above.  */
     821                 :             :           while (ISDIGIT (*format))
     822                 :             :             format++;
     823                 :             : 
     824                 :             :           /* Skip over the dollar sign.  */
     825                 :             :           format++;
     826                 :             :         }
     827                 :             : 
     828                 :             :       switch (*format)
     829                 :             :         {
     830                 :             :         case '%':
     831                 :             :           error_char ('%');
     832                 :             :           break;
     833                 :             : 
     834                 :             :         case 'c':
     835                 :             :           error_char (spec[n++].u.charval);
     836                 :             :           break;
     837                 :             : 
     838                 :             :         case 's':
     839                 :             :         case 'C':               /* Current locus */
     840                 :             :         case 'L':               /* Specified locus */
     841                 :             :           error_string (spec[n++].u.stringval);
     842                 :             :           break;
     843                 :             : 
     844                 :             :         case 'd':
     845                 :             :         case 'i':
     846                 :             :           error_integer (spec[n++].u.intval);
     847                 :             :           break;
     848                 :             : 
     849                 :             :         case 'u':
     850                 :             :           error_uinteger (spec[n++].u.uintval);
     851                 :             :           break;
     852                 :             : 
     853                 :             :         case 'l':
     854                 :             :           format++;
     855                 :             :           if (*format == 'l')
     856                 :             :             {
     857                 :             :               format++;
     858                 :             :               if (*format == 'u')
     859                 :             :                 error_uinteger (spec[n++].u.ullongintval);
     860                 :             :               else
     861                 :             :                 error_integer (spec[n++].u.llongintval);
     862                 :             :             }
     863                 :             :           if (*format == 'u')
     864                 :             :             error_uinteger (spec[n++].u.ulongintval);
     865                 :             :           else
     866                 :             :             error_integer (spec[n++].u.longintval);
     867                 :             :           break;
     868                 :             : 
     869                 :             :         case 'w':
     870                 :             :           format++;
     871                 :             :           if (*format == 'u')
     872                 :             :             error_hwuint (spec[n++].u.hwintval);
     873                 :             :           else
     874                 :             :             error_hwint (spec[n++].u.hwuintval);
     875                 :             :           break;
     876                 :             : 
     877                 :             :         case 'z':
     878                 :             :           format++;
     879                 :             :           if (*format == 'u')
     880                 :             :             error_uinteger (spec[n++].u.sizeval);
     881                 :             :           else
     882                 :             :             error_integer (spec[n++].u.ssizeval);
     883                 :             :           break;
     884                 :             : 
     885                 :             :         case 't':
     886                 :             :           format++;
     887                 :             :           if (*format == 'u')
     888                 :             :             {
     889                 :             :               unsigned long long a = spec[n++].u.ptrdiffval, m;
     890                 :             : #ifdef PTRDIFF_MAX
     891                 :             :               m = PTRDIFF_MAX;
     892                 :             : #else
     893                 :             :               m = INTTYPE_MAXIMUM (ptrdiff_t);
     894                 :             : #endif
     895                 :             :               m = 2 * m + 1;
     896                 :             :               error_uinteger (a & m);
     897                 :             :             }
     898                 :             :           else
     899                 :             :             error_integer (spec[n++].u.ptrdiffval);
     900                 :             :           break;
     901                 :             :         }
     902                 :             :     }
     903                 :             : 
     904                 :           0 :   error_char ('\n');
     905                 :           0 : }
     906                 :             : 
     907                 :             : 
     908                 :             : /* Wrapper for error_print().  */
     909                 :             : 
     910                 :             : static void
     911                 :           0 : error_printf (const char *gmsgid, ...)
     912                 :             : {
     913                 :           0 :   va_list argp;
     914                 :             : 
     915                 :           0 :   va_start (argp, gmsgid);
     916                 :           0 :   error_print ("", _(gmsgid), argp);
     917                 :           0 :   va_end (argp);
     918                 :           0 : }
     919                 :             : 
     920                 :             : 
     921                 :             : /* Clear any output buffered in a pretty-print output_buffer.  */
     922                 :             : 
     923                 :             : static void
     924                 :    20671440 : gfc_clear_pp_buffer (output_buffer *this_buffer)
     925                 :             : {
     926                 :    20671440 :   pretty_printer *pp = global_dc->printer;
     927                 :    20671440 :   output_buffer *tmp_buffer = pp_buffer (pp);
     928                 :    20671440 :   pp_buffer (pp) = this_buffer;
     929                 :    20671440 :   pp_clear_output_area (pp);
     930                 :    20671440 :   pp_buffer (pp) = tmp_buffer;
     931                 :             :   /* We need to reset last_location, otherwise we may skip caret lines
     932                 :             :      when we actually give a diagnostic.  */
     933                 :    20671440 :   global_dc->m_last_location = UNKNOWN_LOCATION;
     934                 :    20671440 : }
     935                 :             : 
     936                 :             : /* The currently-printing diagnostic, for use by gfc_format_decoder,
     937                 :             :    for colorizing %C and %L.  */
     938                 :             : 
     939                 :             : static diagnostic_info *curr_diagnostic;
     940                 :             : 
     941                 :             : /* A helper function to call diagnostic_report_diagnostic, while setting
     942                 :             :    curr_diagnostic for the duration of the call.  */
     943                 :             : 
     944                 :             : static bool
     945                 :     1120705 : gfc_report_diagnostic (diagnostic_info *diagnostic)
     946                 :             : {
     947                 :     1120705 :   gcc_assert (diagnostic != NULL);
     948                 :     1120705 :   curr_diagnostic = diagnostic;
     949                 :     1120705 :   bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
     950                 :     1120697 :   curr_diagnostic = NULL;
     951                 :     1120697 :   return ret;
     952                 :             : }
     953                 :             : 
     954                 :             : /* This is just a helper function to avoid duplicating the logic of
     955                 :             :    gfc_warning.  */
     956                 :             : 
     957                 :             : static bool
     958                 :       19241 : gfc_warning (int opt, const char *gmsgid, va_list ap)
     959                 :             : {
     960                 :       19241 :   va_list argp;
     961                 :       19241 :   va_copy (argp, ap);
     962                 :             : 
     963                 :       19241 :   diagnostic_info diagnostic;
     964                 :       19241 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
     965                 :       19241 :   bool fatal_errors = global_dc->m_fatal_errors;
     966                 :       19241 :   pretty_printer *pp = global_dc->printer;
     967                 :       19241 :   output_buffer *tmp_buffer = pp_buffer (pp);
     968                 :             : 
     969                 :       19241 :   gfc_clear_pp_buffer (pp_warning_buffer);
     970                 :             : 
     971                 :       19241 :   if (buffered_p)
     972                 :             :     {
     973                 :       15501 :       pp_buffer (pp) = pp_warning_buffer;
     974                 :       15501 :       global_dc->m_fatal_errors = false;
     975                 :             :       /* To prevent -fmax-errors= triggering.  */
     976                 :       15501 :       --werrorcount;
     977                 :             :     }
     978                 :             : 
     979                 :       19241 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
     980                 :             :                        DK_WARNING);
     981                 :       19241 :   diagnostic.option_index = opt;
     982                 :       19241 :   bool ret = gfc_report_diagnostic (&diagnostic);
     983                 :             : 
     984                 :       19241 :   if (buffered_p)
     985                 :             :     {
     986                 :       15501 :       pp_buffer (pp) = tmp_buffer;
     987                 :       15501 :       global_dc->m_fatal_errors = fatal_errors;
     988                 :             : 
     989                 :       15501 :       warningcount_buffered = 0;
     990                 :       15501 :       werrorcount_buffered = 0;
     991                 :             :       /* Undo the above --werrorcount if not Werror, otherwise
     992                 :             :          werrorcount is correct already.  */
     993                 :       15501 :       if (!ret)
     994                 :          12 :         ++werrorcount;
     995                 :       15489 :       else if (diagnostic.kind == DK_ERROR)
     996                 :           1 :         ++werrorcount_buffered;
     997                 :             :       else
     998                 :       15488 :         ++werrorcount, --warningcount, ++warningcount_buffered;
     999                 :             :     }
    1000                 :             : 
    1001                 :       19241 :   va_end (argp);
    1002                 :       38482 :   return ret;
    1003                 :       19241 : }
    1004                 :             : 
    1005                 :             : /* Issue a warning.  */
    1006                 :             : 
    1007                 :             : bool
    1008                 :        3612 : gfc_warning (int opt, const char *gmsgid, ...)
    1009                 :             : {
    1010                 :        3612 :   va_list argp;
    1011                 :             : 
    1012                 :        3612 :   va_start (argp, gmsgid);
    1013                 :        3612 :   bool ret = gfc_warning (opt, gmsgid, argp);
    1014                 :        3612 :   va_end (argp);
    1015                 :        3612 :   return ret;
    1016                 :             : }
    1017                 :             : 
    1018                 :             : 
    1019                 :             : /* Whether, for a feature included in a given standard set (GFC_STD_*),
    1020                 :             :    we should issue an error or a warning, or be quiet.  */
    1021                 :             : 
    1022                 :             : notification
    1023                 :      233061 : gfc_notification_std (int std)
    1024                 :             : {
    1025                 :      233061 :   bool warning;
    1026                 :             : 
    1027                 :      233061 :   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
    1028                 :      233061 :   if ((gfc_option.allow_std & std) != 0 && !warning)
    1029                 :             :     return SILENT;
    1030                 :             : 
    1031                 :         384 :   return warning ? WARNING : ERROR;
    1032                 :             : }
    1033                 :             : 
    1034                 :             : 
    1035                 :             : /* Return a string describing the nature of a standard violation
    1036                 :             :  * and/or the relevant version of the standard.  */
    1037                 :             : 
    1038                 :             : char const*
    1039                 :       16330 : notify_std_msg(int std)
    1040                 :             : {
    1041                 :             : 
    1042                 :       16330 :   if (std & GFC_STD_F2023_DEL)
    1043                 :          10 :     return _("Prohibited in Fortran 2023:");
    1044                 :       16320 :   else if (std & GFC_STD_F2023)
    1045                 :           5 :     return _("Fortran 2023:");
    1046                 :       16315 :   else if (std & GFC_STD_F2018_DEL)
    1047                 :           1 :     return _("Fortran 2018 deleted feature:");
    1048                 :       16314 :   else if (std & GFC_STD_F2018_OBS)
    1049                 :           8 :     return _("Fortran 2018 obsolescent feature:");
    1050                 :       16306 :   else if (std & GFC_STD_F2018)
    1051                 :         118 :     return _("Fortran 2018:");
    1052                 :       16188 :   else if (std & GFC_STD_F2008_OBS)
    1053                 :           2 :     return _("Fortran 2008 obsolescent feature:");
    1054                 :       16186 :   else if (std & GFC_STD_F2008)
    1055                 :             :     return "Fortran 2008:";
    1056                 :       15795 :   else if (std & GFC_STD_F2003)
    1057                 :             :     return "Fortran 2003:";
    1058                 :       15669 :   else if (std & GFC_STD_GNU)
    1059                 :         393 :     return _("GNU Extension:");
    1060                 :       15276 :   else if (std & GFC_STD_LEGACY)
    1061                 :       11549 :     return _("Legacy Extension:");
    1062                 :        3727 :   else if (std & GFC_STD_F95_OBS)
    1063                 :        3597 :     return _("Obsolescent feature:");
    1064                 :         130 :   else if (std & GFC_STD_F95_DEL)
    1065                 :         130 :     return _("Deleted feature:");
    1066                 :             :   else
    1067                 :           0 :     gcc_unreachable ();
    1068                 :             : }
    1069                 :             : 
    1070                 :             : 
    1071                 :             : /* Possibly issue a warning/error about use of a nonstandard (or deleted)
    1072                 :             :    feature.  An error/warning will be issued if the currently selected
    1073                 :             :    standard does not contain the requested bits.  Return false if
    1074                 :             :    an error is generated.  */
    1075                 :             : 
    1076                 :             : bool
    1077                 :      293713 : gfc_notify_std (int std, const char *gmsgid, ...)
    1078                 :             : {
    1079                 :      293713 :   va_list argp;
    1080                 :      293713 :   const char *msg, *msg2;
    1081                 :      293713 :   char *buffer;
    1082                 :             : 
    1083                 :             :   /* Determine whether an error or a warning is needed.  */
    1084                 :      293713 :   const int wstd = std & gfc_option.warn_std;    /* Standard to warn about.  */
    1085                 :      293713 :   const int estd = std & ~gfc_option.allow_std;  /* Standard to error about.  */
    1086                 :      293713 :   const bool warning = (wstd != 0) && !inhibit_warnings;
    1087                 :      293713 :   const bool error = (estd != 0);
    1088                 :             : 
    1089                 :      293713 :   if (!error && !warning)
    1090                 :             :     return true;
    1091                 :       16331 :   if (suppress_errors)
    1092                 :             :     return !error;
    1093                 :             : 
    1094                 :       16330 :   if (error)
    1095                 :         745 :     msg = notify_std_msg (estd);
    1096                 :             :   else
    1097                 :       15585 :     msg = notify_std_msg (wstd);
    1098                 :             : 
    1099                 :       16330 :   msg2 = _(gmsgid);
    1100                 :       16330 :   buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
    1101                 :       16330 :   strcpy (buffer, msg);
    1102                 :       16330 :   strcat (buffer, " ");
    1103                 :       16330 :   strcat (buffer, msg2);
    1104                 :             : 
    1105                 :       16330 :   va_start (argp, gmsgid);
    1106                 :       16330 :   if (error)
    1107                 :         745 :     gfc_error_opt (0, buffer, argp);
    1108                 :             :   else
    1109                 :       15585 :     gfc_warning (0, buffer, argp);
    1110                 :       16330 :   va_end (argp);
    1111                 :             : 
    1112                 :       16330 :   if (error)
    1113                 :             :     return false;
    1114                 :             :   else
    1115                 :       15588 :     return (warning && !warnings_are_errors);
    1116                 :             : }
    1117                 :             : 
    1118                 :             : 
    1119                 :             : /* Called from output_format -- during diagnostic message processing
    1120                 :             :    to handle Fortran specific format specifiers with the following meanings:
    1121                 :             : 
    1122                 :             :    %C  Current locus (no argument)
    1123                 :             :    %L  Takes locus argument
    1124                 :             : */
    1125                 :             : static bool
    1126                 :     1096576 : gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec,
    1127                 :             :                     int precision, bool wide, bool set_locus, bool hash,
    1128                 :             :                     bool *quoted, const char **buffer_ptr)
    1129                 :             : {
    1130                 :     1096576 :   switch (*spec)
    1131                 :             :     {
    1132                 :     1096553 :     case 'C':
    1133                 :     1096553 :     case 'L':
    1134                 :     1096553 :       {
    1135                 :     1096553 :         static const char *result[2] = { "(1)", "(2)" };
    1136                 :     1096553 :         locus *loc;
    1137                 :     1096553 :         if (*spec == 'C')
    1138                 :             :           loc = &gfc_current_locus;
    1139                 :             :         else
    1140                 :       15037 :           loc = va_arg (*text->m_args_ptr, locus *);
    1141                 :     1096553 :         gcc_assert (loc->nextc - loc->lb->line >= 0);
    1142                 :     1096553 :         unsigned int offset = loc->nextc - loc->lb->line;
    1143                 :     1096553 :         if (*spec == 'C' && *loc->nextc != '\0')
    1144                 :             :           /* Point %C first offending character not the last good one. */
    1145                 :     1023966 :           offset++;
    1146                 :             :         /* If location[0] != UNKNOWN_LOCATION means that we already
    1147                 :             :            processed one of %C/%L.  */
    1148                 :     1096553 :         int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
    1149                 :     1096553 :         location_t src_loc
    1150                 :     2193106 :           = linemap_position_for_loc_and_offset (line_table,
    1151                 :     1096553 :                                                  loc->lb->location,
    1152                 :             :                                                  offset);
    1153                 :     1096553 :         text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET);
    1154                 :             :         /* Colorize the markers to match the color choices of
    1155                 :             :            diagnostic_show_locus (the initial location has a color given
    1156                 :             :            by the "kind" of the diagnostic, the secondary location has
    1157                 :             :            color "range1").  */
    1158                 :     1096553 :         gcc_assert (curr_diagnostic != NULL);
    1159                 :     1096553 :         const char *color
    1160                 :             :           = (loc_num
    1161                 :     1096553 :              ? "range1"
    1162                 :     1096111 :              : diagnostic_get_color_for_kind (curr_diagnostic->kind));
    1163                 :     1096553 :         pp_string (pp, colorize_start (pp_show_color (pp), color));
    1164                 :     1096553 :         pp_string (pp, result[loc_num]);
    1165                 :     1096553 :         pp_string (pp, colorize_stop (pp_show_color (pp)));
    1166                 :     1096553 :         return true;
    1167                 :             :       }
    1168                 :          23 :     default:
    1169                 :             :       /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
    1170                 :             :          etc. diagnostics can use the FE printer while the FE is still
    1171                 :             :          active.  */
    1172                 :          23 :       return default_tree_printer (pp, text, spec, precision, wide,
    1173                 :          23 :                                    set_locus, hash, quoted, buffer_ptr);
    1174                 :             :     }
    1175                 :             : }
    1176                 :             : 
    1177                 :             : /* Return a malloc'd string describing the kind of diagnostic.  The
    1178                 :             :    caller is responsible for freeing the memory.  */
    1179                 :             : static char *
    1180                 :     1098768 : gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
    1181                 :             :                                   const diagnostic_info *diagnostic)
    1182                 :             : {
    1183                 :     1098768 :   static const char *const diagnostic_kind_text[] = {
    1184                 :             : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
    1185                 :             : #include "gfc-diagnostic.def"
    1186                 :             : #undef DEFINE_DIAGNOSTIC_KIND
    1187                 :             :     "must-not-happen"
    1188                 :             :   };
    1189                 :     1098768 :   static const char *const diagnostic_kind_color[] = {
    1190                 :             : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
    1191                 :             : #include "gfc-diagnostic.def"
    1192                 :             : #undef DEFINE_DIAGNOSTIC_KIND
    1193                 :             :     NULL
    1194                 :             :   };
    1195                 :     1098768 :   gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND);
    1196                 :     1098768 :   const char *text = _(diagnostic_kind_text[diagnostic->kind]);
    1197                 :     1098768 :   const char *text_cs = "", *text_ce = "";
    1198                 :     1098768 :   pretty_printer *pp = context->printer;
    1199                 :             : 
    1200                 :     1098768 :   if (diagnostic_kind_color[diagnostic->kind])
    1201                 :             :     {
    1202                 :     2197536 :       text_cs = colorize_start (pp_show_color (pp),
    1203                 :     1098768 :                                 diagnostic_kind_color[diagnostic->kind]);
    1204                 :     1098768 :       text_ce = colorize_stop (pp_show_color (pp));
    1205                 :             :     }
    1206                 :     1098768 :   return build_message_string ("%s%s:%s ", text_cs, text, text_ce);
    1207                 :             : }
    1208                 :             : 
    1209                 :             : /* Return a malloc'd string describing a location.  The caller is
    1210                 :             :    responsible for freeing the memory.  */
    1211                 :             : static char *
    1212                 :     1098905 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
    1213                 :             :                                    expanded_location s)
    1214                 :             : {
    1215                 :     1098905 :   pretty_printer *pp = context->printer;
    1216                 :     1098905 :   const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
    1217                 :     1098905 :   const char *locus_ce = colorize_stop (pp_show_color (pp));
    1218                 :     1098905 :   return (s.file == NULL
    1219                 :     1098905 :           ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
    1220                 :     1098841 :           : !strcmp (s.file, special_fname_builtin ())
    1221                 :     1098841 :           ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
    1222                 :     1098831 :           : context->m_show_column
    1223                 :     1098831 :           ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
    1224                 :             :                                   s.column, locus_ce)
    1225                 :           0 :           : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
    1226                 :             : }
    1227                 :             : 
    1228                 :             : /* Return a malloc'd string describing two locations.  The caller is
    1229                 :             :    responsible for freeing the memory.  */
    1230                 :             : static char *
    1231                 :         152 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
    1232                 :             :                                    expanded_location s, expanded_location s2)
    1233                 :             : {
    1234                 :         152 :   pretty_printer *pp = context->printer;
    1235                 :         152 :   const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
    1236                 :         152 :   const char *locus_ce = colorize_stop (pp_show_color (pp));
    1237                 :             : 
    1238                 :         152 :   return (s.file == NULL
    1239                 :         152 :           ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
    1240                 :         152 :           : !strcmp (s.file, special_fname_builtin ())
    1241                 :         152 :           ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
    1242                 :         152 :           : context->m_show_column
    1243                 :         152 :           ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
    1244                 :             :                                   MIN (s.column, s2.column),
    1245                 :             :                                   MAX (s.column, s2.column), locus_ce)
    1246                 :           0 :           : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
    1247                 :         152 :                                   locus_ce));
    1248                 :             : }
    1249                 :             : 
    1250                 :             : /* This function prints the locus (file:line:column), the diagnostic kind
    1251                 :             :    (Error, Warning) and (optionally) the relevant lines of code with
    1252                 :             :    annotation lines with '1' and/or '2' below them.
    1253                 :             : 
    1254                 :             :    With -fdiagnostic-show-caret (the default) it prints:
    1255                 :             : 
    1256                 :             :        [locus of primary range]:
    1257                 :             : 
    1258                 :             :           some code
    1259                 :             :                  1
    1260                 :             :        Error: Some error at (1)
    1261                 :             : 
    1262                 :             :   With -fno-diagnostic-show-caret or if the primary range is not
    1263                 :             :   valid, it prints:
    1264                 :             : 
    1265                 :             :        [locus of primary range]: Error: Some error at (1) and (2)
    1266                 :             : */
    1267                 :             : static void
    1268                 :     1098768 : gfc_diagnostic_starter (diagnostic_context *context,
    1269                 :             :                         const diagnostic_info *diagnostic)
    1270                 :             : {
    1271                 :     1098768 :   char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
    1272                 :             : 
    1273                 :     1098768 :   expanded_location s1 = diagnostic_expand_location (diagnostic);
    1274                 :     1098768 :   expanded_location s2;
    1275                 :     1098768 :   bool one_locus = diagnostic->richloc->get_num_locations () < 2;
    1276                 :     1098768 :   bool same_locus = false;
    1277                 :             : 
    1278                 :     1098768 :   if (!one_locus)
    1279                 :             :     {
    1280                 :         442 :       s2 = diagnostic_expand_location (diagnostic, 1);
    1281                 :         884 :       same_locus = diagnostic_same_line (context, s1, s2);
    1282                 :             :     }
    1283                 :             : 
    1284                 :     1098768 :   char * locus_prefix = (one_locus || !same_locus)
    1285                 :     1098768 :     ? gfc_diagnostic_build_locus_prefix (context, s1)
    1286                 :         152 :     : gfc_diagnostic_build_locus_prefix (context, s1, s2);
    1287                 :             : 
    1288                 :     1098768 :   if (!context->m_source_printing.enabled
    1289                 :       16130 :       || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
    1290                 :     1114898 :       || diagnostic_location (diagnostic, 0) == context->m_last_location)
    1291                 :             :     {
    1292                 :     1082638 :       pp_set_prefix (context->printer,
    1293                 :             :                      concat (locus_prefix, " ", kind_prefix, NULL));
    1294                 :     1082638 :       free (locus_prefix);
    1295                 :             : 
    1296                 :     1082638 :       if (one_locus || same_locus)
    1297                 :             :         {
    1298                 :     1082350 :           free (kind_prefix);
    1299                 :     1082350 :           return;
    1300                 :             :         }
    1301                 :             :       /* In this case, we print the previous locus and prefix as:
    1302                 :             : 
    1303                 :             :           [locus]:[prefix]: (1)
    1304                 :             : 
    1305                 :             :          and we flush with a new line before setting the new prefix.  */
    1306                 :         288 :       pp_string (context->printer, "(1)");
    1307                 :         288 :       pp_newline (context->printer);
    1308                 :         288 :       locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
    1309                 :         288 :       pp_set_prefix (context->printer,
    1310                 :             :                      concat (locus_prefix, " ", kind_prefix, NULL));
    1311                 :         288 :       free (kind_prefix);
    1312                 :         288 :       free (locus_prefix);
    1313                 :             :     }
    1314                 :             :   else
    1315                 :             :     {
    1316                 :       16130 :       pp_verbatim (context->printer, "%s", locus_prefix);
    1317                 :       16130 :       free (locus_prefix);
    1318                 :             :       /* Fortran uses an empty line between locus and caret line.  */
    1319                 :       16130 :       pp_newline (context->printer);
    1320                 :       16130 :       pp_set_prefix (context->printer, NULL);
    1321                 :       16130 :       pp_newline (context->printer);
    1322                 :       16130 :       diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind);
    1323                 :             :       /* If the caret line was shown, the prefix does not contain the
    1324                 :             :          locus.  */
    1325                 :       16130 :       pp_set_prefix (context->printer, kind_prefix);
    1326                 :             :     }
    1327                 :             : }
    1328                 :             : 
    1329                 :             : static void
    1330                 :           1 : gfc_diagnostic_start_span (diagnostic_context *context,
    1331                 :             :                            expanded_location exploc)
    1332                 :             : {
    1333                 :           1 :   char *locus_prefix;
    1334                 :           1 :   locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
    1335                 :           1 :   pp_verbatim (context->printer, "%s", locus_prefix);
    1336                 :           1 :   free (locus_prefix);
    1337                 :           1 :   pp_newline (context->printer);
    1338                 :             :   /* Fortran uses an empty line between locus and caret line.  */
    1339                 :           1 :   pp_newline (context->printer);
    1340                 :           1 : }
    1341                 :             : 
    1342                 :             : 
    1343                 :             : static void
    1344                 :     1098768 : gfc_diagnostic_finalizer (diagnostic_context *context,
    1345                 :             :                           const diagnostic_info *diagnostic ATTRIBUTE_UNUSED,
    1346                 :             :                           diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED)
    1347                 :             : {
    1348                 :     1098768 :   pp_destroy_prefix (context->printer);
    1349                 :     1098768 :   pp_newline_and_flush (context->printer);
    1350                 :     1098768 : }
    1351                 :             : 
    1352                 :             : /* Immediate warning (i.e. do not buffer the warning) with an explicit
    1353                 :             :    location.  */
    1354                 :             : 
    1355                 :             : bool
    1356                 :           3 : gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
    1357                 :             : {
    1358                 :           3 :   va_list argp;
    1359                 :           3 :   diagnostic_info diagnostic;
    1360                 :           3 :   rich_location rich_loc (line_table, loc);
    1361                 :           3 :   bool ret;
    1362                 :             : 
    1363                 :           3 :   va_start (argp, gmsgid);
    1364                 :           3 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING);
    1365                 :           3 :   diagnostic.option_index = opt;
    1366                 :           3 :   ret = gfc_report_diagnostic (&diagnostic);
    1367                 :           3 :   va_end (argp);
    1368                 :           6 :   return ret;
    1369                 :           3 : }
    1370                 :             : 
    1371                 :             : /* Immediate warning (i.e. do not buffer the warning).  */
    1372                 :             : 
    1373                 :             : bool
    1374                 :       23733 : gfc_warning_now (int opt, const char *gmsgid, ...)
    1375                 :             : {
    1376                 :       23733 :   va_list argp;
    1377                 :       23733 :   diagnostic_info diagnostic;
    1378                 :       23733 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1379                 :       23733 :   bool ret;
    1380                 :             : 
    1381                 :       23733 :   va_start (argp, gmsgid);
    1382                 :       23733 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
    1383                 :             :                        DK_WARNING);
    1384                 :       23733 :   diagnostic.option_index = opt;
    1385                 :       23733 :   ret = gfc_report_diagnostic (&diagnostic);
    1386                 :       23733 :   va_end (argp);
    1387                 :       47466 :   return ret;
    1388                 :       23733 : }
    1389                 :             : 
    1390                 :             : /* Internal warning, do not buffer.  */
    1391                 :             : 
    1392                 :             : bool
    1393                 :           0 : gfc_warning_internal (int opt, const char *gmsgid, ...)
    1394                 :             : {
    1395                 :           0 :   va_list argp;
    1396                 :           0 :   diagnostic_info diagnostic;
    1397                 :           0 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1398                 :           0 :   bool ret;
    1399                 :             : 
    1400                 :           0 :   va_start (argp, gmsgid);
    1401                 :           0 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
    1402                 :             :                        DK_WARNING);
    1403                 :           0 :   diagnostic.option_index = opt;
    1404                 :           0 :   ret = gfc_report_diagnostic (&diagnostic);
    1405                 :           0 :   va_end (argp);
    1406                 :           0 :   return ret;
    1407                 :           0 : }
    1408                 :             : 
    1409                 :             : /* Immediate error (i.e. do not buffer).  */
    1410                 :             : 
    1411                 :             : void
    1412                 :         395 : gfc_error_now (const char *gmsgid, ...)
    1413                 :             : {
    1414                 :         395 :   va_list argp;
    1415                 :         395 :   diagnostic_info diagnostic;
    1416                 :         395 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1417                 :             : 
    1418                 :         395 :   error_buffer.flag = true;
    1419                 :             : 
    1420                 :         395 :   va_start (argp, gmsgid);
    1421                 :         395 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR);
    1422                 :         395 :   gfc_report_diagnostic (&diagnostic);
    1423                 :         395 :   va_end (argp);
    1424                 :         395 : }
    1425                 :             : 
    1426                 :             : 
    1427                 :             : /* Fatal error, never returns.  */
    1428                 :             : 
    1429                 :             : void
    1430                 :           8 : gfc_fatal_error (const char *gmsgid, ...)
    1431                 :             : {
    1432                 :           8 :   va_list argp;
    1433                 :           8 :   diagnostic_info diagnostic;
    1434                 :           8 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1435                 :             : 
    1436                 :           8 :   va_start (argp, gmsgid);
    1437                 :           8 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL);
    1438                 :           8 :   gfc_report_diagnostic (&diagnostic);
    1439                 :           0 :   va_end (argp);
    1440                 :             : 
    1441                 :           0 :   gcc_unreachable ();
    1442                 :             : }
    1443                 :             : 
    1444                 :             : /* Clear the warning flag.  */
    1445                 :             : 
    1446                 :             : void
    1447                 :    12062824 : gfc_clear_warning (void)
    1448                 :             : {
    1449                 :    12062824 :   gfc_clear_pp_buffer (pp_warning_buffer);
    1450                 :    12062824 :   warningcount_buffered = 0;
    1451                 :    12062824 :   werrorcount_buffered = 0;
    1452                 :    12062824 : }
    1453                 :             : 
    1454                 :             : 
    1455                 :             : /* Check to see if any warnings have been saved.
    1456                 :             :    If so, print the warning.  */
    1457                 :             : 
    1458                 :             : void
    1459                 :     1175406 : gfc_warning_check (void)
    1460                 :             : {
    1461                 :     1179363 :   if (! gfc_output_buffer_empty_p (pp_warning_buffer))
    1462                 :             :     {
    1463                 :        3957 :       pretty_printer *pp = global_dc->printer;
    1464                 :        3957 :       output_buffer *tmp_buffer = pp_buffer (pp);
    1465                 :        3957 :       pp_buffer (pp) = pp_warning_buffer;
    1466                 :        3957 :       pp_really_flush (pp);
    1467                 :        3957 :       warningcount += warningcount_buffered;
    1468                 :        3957 :       werrorcount += werrorcount_buffered;
    1469                 :        3957 :       gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
    1470                 :        3957 :       pp_buffer (pp) = tmp_buffer;
    1471                 :        3957 :       diagnostic_action_after_output (global_dc,
    1472                 :             :                                       warningcount_buffered
    1473                 :             :                                       ? DK_WARNING : DK_ERROR);
    1474                 :        3957 :       diagnostic_check_max_errors (global_dc, true);
    1475                 :             :     }
    1476                 :     1175406 : }
    1477                 :             : 
    1478                 :             : 
    1479                 :             : /* Issue an error.  */
    1480                 :             : 
    1481                 :             : static void
    1482                 :     1093935 : gfc_error_opt (int opt, const char *gmsgid, va_list ap)
    1483                 :             : {
    1484                 :     1093935 :   va_list argp;
    1485                 :     1093935 :   va_copy (argp, ap);
    1486                 :     1093935 :   bool saved_abort_on_error = false;
    1487                 :             : 
    1488                 :     1093935 :   if (warnings_not_errors)
    1489                 :             :     {
    1490                 :          44 :       gfc_warning (opt, gmsgid, argp);
    1491                 :          44 :       va_end (argp);
    1492                 :       16610 :       return;
    1493                 :             :     }
    1494                 :             : 
    1495                 :     1093891 :   if (suppress_errors)
    1496                 :             :     {
    1497                 :       16566 :       va_end (argp);
    1498                 :       16566 :       return;
    1499                 :             :     }
    1500                 :             : 
    1501                 :     1077325 :   diagnostic_info diagnostic;
    1502                 :     1077325 :   rich_location richloc (line_table, UNKNOWN_LOCATION);
    1503                 :     1077325 :   bool fatal_errors = global_dc->m_fatal_errors;
    1504                 :     1077325 :   pretty_printer *pp = global_dc->printer;
    1505                 :     1077325 :   output_buffer *tmp_buffer = pp_buffer (pp);
    1506                 :             : 
    1507                 :     1077325 :   gfc_clear_pp_buffer (pp_error_buffer);
    1508                 :             : 
    1509                 :     1077325 :   if (buffered_p)
    1510                 :             :     {
    1511                 :             :       /* To prevent -dH from triggering an abort on a buffered error,
    1512                 :             :          save abort_on_error and restore it below.  */
    1513                 :     1070771 :       saved_abort_on_error = global_dc->m_abort_on_error;
    1514                 :     1070771 :       global_dc->m_abort_on_error = false;
    1515                 :     1070771 :       pp_buffer (pp) = pp_error_buffer;
    1516                 :     1070771 :       global_dc->m_fatal_errors = false;
    1517                 :             :       /* To prevent -fmax-errors= triggering, we decrease it before
    1518                 :             :          report_diagnostic increases it.  */
    1519                 :     1070771 :       --errorcount;
    1520                 :             :     }
    1521                 :             : 
    1522                 :     1077325 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR);
    1523                 :     1077325 :   gfc_report_diagnostic (&diagnostic);
    1524                 :             : 
    1525                 :     1077325 :   if (buffered_p)
    1526                 :             :     {
    1527                 :     1070771 :       pp_buffer (pp) = tmp_buffer;
    1528                 :     1070771 :       global_dc->m_fatal_errors = fatal_errors;
    1529                 :     1070771 :       global_dc->m_abort_on_error = saved_abort_on_error;
    1530                 :             : 
    1531                 :             :     }
    1532                 :             : 
    1533                 :     1077325 :   va_end (argp);
    1534                 :     1077325 : }
    1535                 :             : 
    1536                 :             : 
    1537                 :             : void
    1538                 :         246 : gfc_error_opt (int opt, const char *gmsgid, ...)
    1539                 :             : {
    1540                 :         246 :   va_list argp;
    1541                 :         246 :   va_start (argp, gmsgid);
    1542                 :         246 :   gfc_error_opt (opt, gmsgid, argp);
    1543                 :         246 :   va_end (argp);
    1544                 :         246 : }
    1545                 :             : 
    1546                 :             : 
    1547                 :             : void
    1548                 :     1092944 : gfc_error (const char *gmsgid, ...)
    1549                 :             : {
    1550                 :     1092944 :   va_list argp;
    1551                 :     1092944 :   va_start (argp, gmsgid);
    1552                 :     1092944 :   gfc_error_opt (0, gmsgid, argp);
    1553                 :     1092944 :   va_end (argp);
    1554                 :     1092944 : }
    1555                 :             : 
    1556                 :             : 
    1557                 :             : /* This shouldn't happen... but sometimes does.  */
    1558                 :             : 
    1559                 :             : void
    1560                 :           0 : gfc_internal_error (const char *gmsgid, ...)
    1561                 :             : {
    1562                 :           0 :   int e, w;
    1563                 :           0 :   va_list argp;
    1564                 :           0 :   diagnostic_info diagnostic;
    1565                 :           0 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1566                 :             : 
    1567                 :           0 :   gfc_get_errors (&w, &e);
    1568                 :           0 :   if (e > 0)
    1569                 :           0 :     exit(EXIT_FAILURE);
    1570                 :             : 
    1571                 :           0 :   va_start (argp, gmsgid);
    1572                 :           0 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
    1573                 :           0 :   gfc_report_diagnostic (&diagnostic);
    1574                 :           0 :   va_end (argp);
    1575                 :             : 
    1576                 :           0 :   gcc_unreachable ();
    1577                 :             : }
    1578                 :             : 
    1579                 :             : 
    1580                 :             : /* Clear the error flag when we start to compile a source line.  */
    1581                 :             : 
    1582                 :             : void
    1583                 :     4639352 : gfc_clear_error (void)
    1584                 :             : {
    1585                 :     4639352 :   error_buffer.flag = false;
    1586                 :     4639352 :   warnings_not_errors = false;
    1587                 :     4639352 :   gfc_clear_pp_buffer (pp_error_buffer);
    1588                 :     4639352 : }
    1589                 :             : 
    1590                 :             : 
    1591                 :             : /* Tests the state of error_flag.  */
    1592                 :             : 
    1593                 :             : bool
    1594                 :     1475770 : gfc_error_flag_test (void)
    1595                 :             : {
    1596                 :     1475770 :   return error_buffer.flag
    1597                 :     2439437 :     || !gfc_output_buffer_empty_p (pp_error_buffer);
    1598                 :             : }
    1599                 :             : 
    1600                 :             : 
    1601                 :             : /* Check to see if any errors have been saved.
    1602                 :             :    If so, print the error.  Returns the state of error_flag.  */
    1603                 :             : 
    1604                 :             : bool
    1605                 :        5190 : gfc_error_check (void)
    1606                 :             : {
    1607                 :        5190 :   if (error_buffer.flag
    1608                 :        8106 :       || ! gfc_output_buffer_empty_p (pp_error_buffer))
    1609                 :             :     {
    1610                 :        2940 :       error_buffer.flag = false;
    1611                 :        2940 :       pretty_printer *pp = global_dc->printer;
    1612                 :        2940 :       output_buffer *tmp_buffer = pp_buffer (pp);
    1613                 :        2940 :       pp_buffer (pp) = pp_error_buffer;
    1614                 :        2940 :       pp_really_flush (pp);
    1615                 :        2940 :       ++errorcount;
    1616                 :        2940 :       gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
    1617                 :        2940 :       pp_buffer (pp) = tmp_buffer;
    1618                 :        2940 :       diagnostic_action_after_output (global_dc, DK_ERROR);
    1619                 :        2940 :       diagnostic_check_max_errors (global_dc, true);
    1620                 :        2940 :       return true;
    1621                 :             :     }
    1622                 :             : 
    1623                 :             :   return false;
    1624                 :             : }
    1625                 :             : 
    1626                 :             : /* Move the text buffered from FROM to TO, then clear
    1627                 :             :    FROM. Independently if there was text in FROM, TO is also
    1628                 :             :    cleared. */
    1629                 :             : 
    1630                 :             : static void
    1631                 :     2721470 : gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
    1632                 :             :                                gfc_error_buffer * buffer_to)
    1633                 :             : {
    1634                 :     2721470 :   output_buffer * from = &(buffer_from->buffer);
    1635                 :     2721470 :   output_buffer * to =  &(buffer_to->buffer);
    1636                 :             : 
    1637                 :     2721470 :   buffer_to->flag = buffer_from->flag;
    1638                 :     2721470 :   buffer_from->flag = false;
    1639                 :             : 
    1640                 :     2721470 :   gfc_clear_pp_buffer (to);
    1641                 :             :   /* We make sure this is always buffered.  */
    1642                 :     2721470 :   to->flush_p = false;
    1643                 :             : 
    1644                 :     2813922 :   if (! gfc_output_buffer_empty_p (from))
    1645                 :             :     {
    1646                 :       92452 :       const char *str = output_buffer_formatted_text (from);
    1647                 :       92452 :       output_buffer_append_r (to, str, strlen (str));
    1648                 :       92452 :       gfc_clear_pp_buffer (from);
    1649                 :             :     }
    1650                 :     2721470 : }
    1651                 :             : 
    1652                 :             : /* Save the existing error state.  */
    1653                 :             : 
    1654                 :             : void
    1655                 :     1390179 : gfc_push_error (gfc_error_buffer *err)
    1656                 :             : {
    1657                 :     1390179 :   gfc_move_error_buffer_from_to (&error_buffer, err);
    1658                 :     1390179 : }
    1659                 :             : 
    1660                 :             : 
    1661                 :             : /* Restore a previous pushed error state.  */
    1662                 :             : 
    1663                 :             : void
    1664                 :     1331291 : gfc_pop_error (gfc_error_buffer *err)
    1665                 :             : {
    1666                 :     1331291 :   gfc_move_error_buffer_from_to (err, &error_buffer);
    1667                 :     1331291 : }
    1668                 :             : 
    1669                 :             : 
    1670                 :             : /* Free a pushed error state, but keep the current error state.  */
    1671                 :             : 
    1672                 :             : void
    1673                 :       58776 : gfc_free_error (gfc_error_buffer *err)
    1674                 :             : {
    1675                 :       58776 :   gfc_clear_pp_buffer (&(err->buffer));
    1676                 :       58776 : }
    1677                 :             : 
    1678                 :             : 
    1679                 :             : /* Report the number of warnings and errors that occurred to the caller.  */
    1680                 :             : 
    1681                 :             : void
    1682                 :      313472 : gfc_get_errors (int *w, int *e)
    1683                 :             : {
    1684                 :      313472 :   if (w != NULL)
    1685                 :      265032 :     *w = warningcount + werrorcount;
    1686                 :      313472 :   if (e != NULL)
    1687                 :      313472 :     *e = errorcount + sorrycount + werrorcount;
    1688                 :      313472 : }
    1689                 :             : 
    1690                 :             : 
    1691                 :             : /* Switch errors into warnings.  */
    1692                 :             : 
    1693                 :             : void
    1694                 :       47426 : gfc_errors_to_warnings (bool f)
    1695                 :             : {
    1696                 :       47426 :   warnings_not_errors = f;
    1697                 :       47426 : }
    1698                 :             : 
    1699                 :             : void
    1700                 :       29875 : gfc_diagnostics_init (void)
    1701                 :             : {
    1702                 :       29875 :   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
    1703                 :       29875 :   diagnostic_start_span (global_dc) = gfc_diagnostic_start_span;
    1704                 :       29875 :   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
    1705                 :       29875 :   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
    1706                 :       29875 :   global_dc->m_source_printing.caret_chars[0] = '1';
    1707                 :       29875 :   global_dc->m_source_printing.caret_chars[1] = '2';
    1708                 :       29875 :   pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
    1709                 :       29875 :   pp_warning_buffer->flush_p = false;
    1710                 :             :   /* pp_error_buffer is statically allocated.  This simplifies memory
    1711                 :             :      management when using gfc_push/pop_error. */
    1712                 :       29875 :   pp_error_buffer = &(error_buffer.buffer);
    1713                 :       29875 :   pp_error_buffer->flush_p = false;
    1714                 :       29875 : }
    1715                 :             : 
    1716                 :             : void
    1717                 :       29849 : gfc_diagnostics_finish (void)
    1718                 :             : {
    1719                 :       29849 :   tree_diagnostics_defaults (global_dc);
    1720                 :             :   /* We still want to use the gfc starter and finalizer, not the tree
    1721                 :             :      defaults.  */
    1722                 :       29849 :   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
    1723                 :       29849 :   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
    1724                 :       29849 :   global_dc->m_source_printing.caret_chars[0] = '^';
    1725                 :       29849 :   global_dc->m_source_printing.caret_chars[1] = '^';
    1726                 :       29849 : }
        

Generated by: LCOV version 2.1-beta

LCOV profile is generated on x86_64 machine using following configure options: configure --disable-bootstrap --enable-coverage=opt --enable-languages=c,c++,fortran,go,jit,lto,rust,m2 --enable-host-shared. GCC test suite is run with the built compiler.