LCOV - code coverage report
Current view: top level - gcc/fortran - error.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 60.7 % 737 447
Test Date: 2023-09-09 13:19:57 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-2023 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                 :     5148727 : 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                 :      387209 : gfc_push_suppress_errors (void)
      71                 :             : {
      72                 :      387209 :   gcc_assert (suppress_errors >= 0);
      73                 :      387209 :   ++suppress_errors;
      74                 :      387209 : }
      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                 :      387209 : gfc_pop_suppress_errors (void)
      87                 :             : {
      88                 :      387209 :   gcc_assert (suppress_errors > 0);
      89                 :      387209 :   --suppress_errors;
      90                 :      387209 : }
      91                 :             : 
      92                 :             : 
      93                 :             : /* Query whether errors are suppressed.  */
      94                 :             : 
      95                 :             : bool
      96                 :         123 : gfc_query_suppress_errors (void)
      97                 :             : {
      98                 :         123 :   return suppress_errors > 0;
      99                 :             : }
     100                 :             : 
     101                 :             : 
     102                 :             : /* Determine terminal width (for trimming source lines in output).  */
     103                 :             : 
     104                 :             : static int
     105                 :       29017 : gfc_get_terminal_width (void)
     106                 :             : {
     107                 :       29017 :   return isatty (STDERR_FILENO) ? get_terminal_width () : INT_MAX;
     108                 :             : }
     109                 :             : 
     110                 :             : 
     111                 :             : /* Per-file error initialization.  */
     112                 :             : 
     113                 :             : void
     114                 :       29017 : gfc_error_init_1 (void)
     115                 :             : {
     116                 :       29017 :   terminal_width = gfc_get_terminal_width ();
     117                 :       29017 :   gfc_buffer_error (false);
     118                 :       29017 : }
     119                 :             : 
     120                 :             : 
     121                 :             : /* Set the flag for buffering errors or not.  */
     122                 :             : 
     123                 :             : void
     124                 :     5505213 : gfc_buffer_error (bool flag)
     125                 :             : {
     126                 :     5505213 :   buffered_p = flag;
     127                 :     5505213 : }
     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, NOTYPE };
     540                 :           0 :   struct
     541                 :             :   {
     542                 :             :     int type;
     543                 :             :     int pos;
     544                 :             :     union
     545                 :             :     {
     546                 :             :       int intval;
     547                 :             :       unsigned int uintval;
     548                 :             :       long int longintval;
     549                 :             :       unsigned long int ulongintval;
     550                 :             :       long long int llongintval;
     551                 :             :       unsigned long long int ullongintval;
     552                 :             :       HOST_WIDE_INT hwintval;
     553                 :             :       unsigned HOST_WIDE_INT hwuintval;
     554                 :             :       char charval;
     555                 :             :       const char * stringval;
     556                 :             :     } u;
     557                 :             :   } arg[MAX_ARGS], spec[MAX_ARGS];
     558                 :             :   /* spec is the array of specifiers, in the same order as they
     559                 :             :      appear in the format string.  arg is the array of arguments,
     560                 :             :      in the same order as they appear in the va_list.  */
     561                 :             : 
     562                 :           0 :   char c;
     563                 :           0 :   int i, n, have_l1, pos, maxpos;
     564                 :           0 :   locus *l1, *l2, *loc;
     565                 :           0 :   const char *format;
     566                 :             : 
     567                 :           0 :   loc = l1 = l2 = NULL;
     568                 :             : 
     569                 :           0 :   have_l1 = 0;
     570                 :           0 :   pos = -1;
     571                 :           0 :   maxpos = -1;
     572                 :             : 
     573                 :           0 :   n = 0;
     574                 :           0 :   format = format0;
     575                 :             : 
     576                 :           0 :   for (i = 0; i < MAX_ARGS; i++)
     577                 :             :     {
     578                 :           0 :       arg[i].type = NOTYPE;
     579                 :           0 :       spec[i].pos = -1;
     580                 :             :     }
     581                 :             : 
     582                 :             :   /* First parse the format string for position specifiers.  */
     583                 :           0 :   while (*format)
     584                 :             :     {
     585                 :           0 :       c = *format++;
     586                 :           0 :       if (c != '%')
     587                 :           0 :         continue;
     588                 :             : 
     589                 :           0 :       if (*format == '%')
     590                 :             :         {
     591                 :           0 :           format++;
     592                 :           0 :           continue;
     593                 :             :         }
     594                 :             : 
     595                 :           0 :       if (ISDIGIT (*format))
     596                 :             :         {
     597                 :             :           /* This is a position specifier.  For example, the number
     598                 :             :              12 in the format string "%12$d", which specifies the third
     599                 :             :              argument of the va_list, formatted in %d format.
     600                 :             :              For details, see "man 3 printf".  */
     601                 :           0 :           pos = atoi(format) - 1;
     602                 :           0 :           gcc_assert (pos >= 0);
     603                 :           0 :           while (ISDIGIT(*format))
     604                 :           0 :             format++;
     605                 :           0 :           gcc_assert (*format == '$');
     606                 :           0 :           format++;
     607                 :             :         }
     608                 :             :       else
     609                 :           0 :         pos++;
     610                 :             : 
     611                 :           0 :       c = *format++;
     612                 :             : 
     613                 :           0 :       if (pos > maxpos)
     614                 :             :         maxpos = pos;
     615                 :             : 
     616                 :           0 :       switch (c)
     617                 :             :         {
     618                 :           0 :           case 'C':
     619                 :           0 :             arg[pos].type = TYPE_CURRENTLOC;
     620                 :           0 :             break;
     621                 :             : 
     622                 :           0 :           case 'L':
     623                 :           0 :             arg[pos].type = TYPE_LOCUS;
     624                 :           0 :             break;
     625                 :             : 
     626                 :           0 :           case 'd':
     627                 :           0 :           case 'i':
     628                 :           0 :             arg[pos].type = TYPE_INTEGER;
     629                 :           0 :             break;
     630                 :             : 
     631                 :           0 :           case 'u':
     632                 :           0 :             arg[pos].type = TYPE_UINTEGER;
     633                 :           0 :             break;
     634                 :             : 
     635                 :           0 :           case 'l':
     636                 :           0 :             c = *format++;
     637                 :           0 :             if (c == 'l')
     638                 :             :               {
     639                 :           0 :                 c = *format++;
     640                 :           0 :                 if (c == 'u')
     641                 :           0 :                   arg[pos].type = TYPE_ULLONGINT;
     642                 :           0 :                 else if (c == 'i' || c == 'd')
     643                 :           0 :                   arg[pos].type = TYPE_LLONGINT;
     644                 :             :                 else
     645                 :           0 :                   gcc_unreachable ();
     646                 :             :               }
     647                 :           0 :             else if (c == 'u')
     648                 :           0 :               arg[pos].type = TYPE_ULONGINT;
     649                 :           0 :             else if (c == 'i' || c == 'd')
     650                 :           0 :               arg[pos].type = TYPE_LONGINT;
     651                 :             :             else
     652                 :           0 :               gcc_unreachable ();
     653                 :             :             break;
     654                 :             : 
     655                 :           0 :           case 'w':
     656                 :           0 :             c = *format++;
     657                 :           0 :             if (c == 'u')
     658                 :           0 :               arg[pos].type = TYPE_HWUINT;
     659                 :           0 :             else if (c == 'i' || c == 'd')
     660                 :           0 :               arg[pos].type = TYPE_HWINT;
     661                 :             :             else
     662                 :           0 :               gcc_unreachable ();
     663                 :             :             break;
     664                 :             : 
     665                 :           0 :           case 'c':
     666                 :           0 :             arg[pos].type = TYPE_CHAR;
     667                 :           0 :             break;
     668                 :             : 
     669                 :           0 :           case 's':
     670                 :           0 :             arg[pos].type = TYPE_STRING;
     671                 :           0 :             break;
     672                 :             : 
     673                 :           0 :           default:
     674                 :           0 :             gcc_unreachable ();
     675                 :             :         }
     676                 :             : 
     677                 :           0 :       spec[n++].pos = pos;
     678                 :             :     }
     679                 :             : 
     680                 :             :   /* Then convert the values for each %-style argument.  */
     681                 :           0 :   for (pos = 0; pos <= maxpos; pos++)
     682                 :             :     {
     683                 :           0 :       gcc_assert (arg[pos].type != NOTYPE);
     684                 :           0 :       switch (arg[pos].type)
     685                 :             :         {
     686                 :           0 :           case TYPE_CURRENTLOC:
     687                 :           0 :             loc = &gfc_current_locus;
     688                 :             :             /* Fall through.  */
     689                 :             : 
     690                 :           0 :           case TYPE_LOCUS:
     691                 :           0 :             if (arg[pos].type == TYPE_LOCUS)
     692                 :           0 :               loc = va_arg (argp, locus *);
     693                 :             : 
     694                 :           0 :             if (have_l1)
     695                 :             :               {
     696                 :           0 :                 l2 = loc;
     697                 :           0 :                 arg[pos].u.stringval = "(2)";
     698                 :             :                 /* Point %C first offending character not the last good one. */
     699                 :           0 :                 if (arg[pos].type == TYPE_CURRENTLOC && *l2->nextc != '\0')
     700                 :           0 :                   l2->nextc++;
     701                 :             :               }
     702                 :             :             else
     703                 :             :               {
     704                 :           0 :                 l1 = loc;
     705                 :           0 :                 have_l1 = 1;
     706                 :           0 :                 arg[pos].u.stringval = "(1)";
     707                 :             :                 /* Point %C first offending character not the last good one. */
     708                 :           0 :                 if (arg[pos].type == TYPE_CURRENTLOC && *l1->nextc != '\0')
     709                 :           0 :                   l1->nextc++;
     710                 :             :               }
     711                 :             :             break;
     712                 :             : 
     713                 :           0 :           case TYPE_INTEGER:
     714                 :           0 :             arg[pos].u.intval = va_arg (argp, int);
     715                 :           0 :             break;
     716                 :             : 
     717                 :           0 :           case TYPE_UINTEGER:
     718                 :           0 :             arg[pos].u.uintval = va_arg (argp, unsigned int);
     719                 :           0 :             break;
     720                 :             : 
     721                 :           0 :           case TYPE_LONGINT:
     722                 :           0 :             arg[pos].u.longintval = va_arg (argp, long int);
     723                 :           0 :             break;
     724                 :             : 
     725                 :           0 :           case TYPE_ULONGINT:
     726                 :           0 :             arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
     727                 :           0 :             break;
     728                 :             : 
     729                 :           0 :           case TYPE_LLONGINT:
     730                 :           0 :             arg[pos].u.llongintval = va_arg (argp, long long int);
     731                 :           0 :             break;
     732                 :             : 
     733                 :           0 :           case TYPE_ULLONGINT:
     734                 :           0 :             arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
     735                 :           0 :             break;
     736                 :             : 
     737                 :           0 :           case TYPE_HWINT:
     738                 :           0 :             arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
     739                 :           0 :             break;
     740                 :             : 
     741                 :           0 :           case TYPE_HWUINT:
     742                 :           0 :             arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
     743                 :           0 :             break;
     744                 :             : 
     745                 :           0 :           case TYPE_CHAR:
     746                 :           0 :             arg[pos].u.charval = (char) va_arg (argp, int);
     747                 :           0 :             break;
     748                 :             : 
     749                 :           0 :           case TYPE_STRING:
     750                 :           0 :             arg[pos].u.stringval = (const char *) va_arg (argp, char *);
     751                 :           0 :             break;
     752                 :             : 
     753                 :           0 :           default:
     754                 :           0 :             gcc_unreachable ();
     755                 :             :         }
     756                 :             :     }
     757                 :             : 
     758                 :           0 :   for (n = 0; spec[n].pos >= 0; n++)
     759                 :             :     spec[n].u = arg[spec[n].pos].u;
     760                 :             : 
     761                 :             :   /* Show the current loci if we have to.  */
     762                 :           0 :   if (have_l1)
     763                 :           0 :     show_loci (l1, l2);
     764                 :             : 
     765                 :           0 :   if (*type)
     766                 :             :     {
     767                 :           0 :       error_string (type);
     768                 :           0 :       error_char (' ');
     769                 :             :     }
     770                 :             : 
     771                 :           0 :   have_l1 = 0;
     772                 :           0 :   format = format0;
     773                 :           0 :   n = 0;
     774                 :             : 
     775                 :           0 :   for (; *format; format++)
     776                 :             :     {
     777                 :             :       if (*format != '%')
     778                 :             :         {
     779                 :             :           error_char (*format);
     780                 :             :           continue;
     781                 :             :         }
     782                 :             : 
     783                 :             :       format++;
     784                 :             :       if (ISDIGIT (*format))
     785                 :             :         {
     786                 :             :           /* This is a position specifier.  See comment above.  */
     787                 :             :           while (ISDIGIT (*format))
     788                 :             :             format++;
     789                 :             : 
     790                 :             :           /* Skip over the dollar sign.  */
     791                 :             :           format++;
     792                 :             :         }
     793                 :             : 
     794                 :             :       switch (*format)
     795                 :             :         {
     796                 :             :         case '%':
     797                 :             :           error_char ('%');
     798                 :             :           break;
     799                 :             : 
     800                 :             :         case 'c':
     801                 :             :           error_char (spec[n++].u.charval);
     802                 :             :           break;
     803                 :             : 
     804                 :             :         case 's':
     805                 :             :         case 'C':               /* Current locus */
     806                 :             :         case 'L':               /* Specified locus */
     807                 :             :           error_string (spec[n++].u.stringval);
     808                 :             :           break;
     809                 :             : 
     810                 :             :         case 'd':
     811                 :             :         case 'i':
     812                 :             :           error_integer (spec[n++].u.intval);
     813                 :             :           break;
     814                 :             : 
     815                 :             :         case 'u':
     816                 :             :           error_uinteger (spec[n++].u.uintval);
     817                 :             :           break;
     818                 :             : 
     819                 :             :         case 'l':
     820                 :             :           format++;
     821                 :             :           if (*format == 'l')
     822                 :             :             {
     823                 :             :               format++;
     824                 :             :               if (*format == 'u')
     825                 :             :                 error_uinteger (spec[n++].u.ullongintval);
     826                 :             :               else
     827                 :             :                 error_integer (spec[n++].u.llongintval);
     828                 :             :             }
     829                 :             :           if (*format == 'u')
     830                 :             :             error_uinteger (spec[n++].u.ulongintval);
     831                 :             :           else
     832                 :             :             error_integer (spec[n++].u.longintval);
     833                 :             :           break;
     834                 :             : 
     835                 :             :         case 'w':
     836                 :             :           format++;
     837                 :             :           if (*format == 'u')
     838                 :             :             error_hwuint (spec[n++].u.hwintval);
     839                 :             :           else
     840                 :             :             error_hwint (spec[n++].u.hwuintval);
     841                 :             :           break;
     842                 :             :         }
     843                 :             :     }
     844                 :             : 
     845                 :           0 :   error_char ('\n');
     846                 :           0 : }
     847                 :             : 
     848                 :             : 
     849                 :             : /* Wrapper for error_print().  */
     850                 :             : 
     851                 :             : static void
     852                 :           0 : error_printf (const char *gmsgid, ...)
     853                 :             : {
     854                 :           0 :   va_list argp;
     855                 :             : 
     856                 :           0 :   va_start (argp, gmsgid);
     857                 :           0 :   error_print ("", _(gmsgid), argp);
     858                 :           0 :   va_end (argp);
     859                 :           0 : }
     860                 :             : 
     861                 :             : 
     862                 :             : /* Clear any output buffered in a pretty-print output_buffer.  */
     863                 :             : 
     864                 :             : static void
     865                 :    19787037 : gfc_clear_pp_buffer (output_buffer *this_buffer)
     866                 :             : {
     867                 :    19787037 :   pretty_printer *pp = global_dc->printer;
     868                 :    19787037 :   output_buffer *tmp_buffer = pp->buffer;
     869                 :    19787037 :   pp->buffer = this_buffer;
     870                 :    19787037 :   pp_clear_output_area (pp);
     871                 :    19787037 :   pp->buffer = tmp_buffer;
     872                 :             :   /* We need to reset last_location, otherwise we may skip caret lines
     873                 :             :      when we actually give a diagnostic.  */
     874                 :    19787037 :   global_dc->last_location = UNKNOWN_LOCATION;
     875                 :    19787037 : }
     876                 :             : 
     877                 :             : /* The currently-printing diagnostic, for use by gfc_format_decoder,
     878                 :             :    for colorizing %C and %L.  */
     879                 :             : 
     880                 :             : static diagnostic_info *curr_diagnostic;
     881                 :             : 
     882                 :             : /* A helper function to call diagnostic_report_diagnostic, while setting
     883                 :             :    curr_diagnostic for the duration of the call.  */
     884                 :             : 
     885                 :             : static bool
     886                 :     1066208 : gfc_report_diagnostic (diagnostic_info *diagnostic)
     887                 :             : {
     888                 :     1066208 :   gcc_assert (diagnostic != NULL);
     889                 :     1066208 :   curr_diagnostic = diagnostic;
     890                 :     1066208 :   bool ret = diagnostic_report_diagnostic (global_dc, diagnostic);
     891                 :     1066200 :   curr_diagnostic = NULL;
     892                 :     1066200 :   return ret;
     893                 :             : }
     894                 :             : 
     895                 :             : /* This is just a helper function to avoid duplicating the logic of
     896                 :             :    gfc_warning.  */
     897                 :             : 
     898                 :             : static bool
     899                 :       18890 : gfc_warning (int opt, const char *gmsgid, va_list ap)
     900                 :             : {
     901                 :       18890 :   va_list argp;
     902                 :       18890 :   va_copy (argp, ap);
     903                 :             : 
     904                 :       18890 :   diagnostic_info diagnostic;
     905                 :       18890 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
     906                 :       18890 :   bool fatal_errors = global_dc->fatal_errors;
     907                 :       18890 :   pretty_printer *pp = global_dc->printer;
     908                 :       18890 :   output_buffer *tmp_buffer = pp->buffer;
     909                 :             : 
     910                 :       18890 :   gfc_clear_pp_buffer (pp_warning_buffer);
     911                 :             : 
     912                 :       18890 :   if (buffered_p)
     913                 :             :     {
     914                 :       15166 :       pp->buffer = pp_warning_buffer;
     915                 :       15166 :       global_dc->fatal_errors = false;
     916                 :             :       /* To prevent -fmax-errors= triggering.  */
     917                 :       15166 :       --werrorcount;
     918                 :             :     }
     919                 :             : 
     920                 :       18890 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
     921                 :             :                        DK_WARNING);
     922                 :       18890 :   diagnostic.option_index = opt;
     923                 :       18890 :   bool ret = gfc_report_diagnostic (&diagnostic);
     924                 :             : 
     925                 :       18890 :   if (buffered_p)
     926                 :             :     {
     927                 :       15166 :       pp->buffer = tmp_buffer;
     928                 :       15166 :       global_dc->fatal_errors = fatal_errors;
     929                 :             : 
     930                 :       15166 :       warningcount_buffered = 0;
     931                 :       15166 :       werrorcount_buffered = 0;
     932                 :             :       /* Undo the above --werrorcount if not Werror, otherwise
     933                 :             :          werrorcount is correct already.  */
     934                 :       15166 :       if (!ret)
     935                 :          12 :         ++werrorcount;
     936                 :       15154 :       else if (diagnostic.kind == DK_ERROR)
     937                 :           1 :         ++werrorcount_buffered;
     938                 :             :       else
     939                 :       15153 :         ++werrorcount, --warningcount, ++warningcount_buffered;
     940                 :             :     }
     941                 :             : 
     942                 :       18890 :   va_end (argp);
     943                 :       37780 :   return ret;
     944                 :       18890 : }
     945                 :             : 
     946                 :             : /* Issue a warning.  */
     947                 :             : 
     948                 :             : bool
     949                 :        3576 : gfc_warning (int opt, const char *gmsgid, ...)
     950                 :             : {
     951                 :        3576 :   va_list argp;
     952                 :             : 
     953                 :        3576 :   va_start (argp, gmsgid);
     954                 :        3576 :   bool ret = gfc_warning (opt, gmsgid, argp);
     955                 :        3576 :   va_end (argp);
     956                 :        3576 :   return ret;
     957                 :             : }
     958                 :             : 
     959                 :             : 
     960                 :             : /* Whether, for a feature included in a given standard set (GFC_STD_*),
     961                 :             :    we should issue an error or a warning, or be quiet.  */
     962                 :             : 
     963                 :             : notification
     964                 :      247146 : gfc_notification_std (int std)
     965                 :             : {
     966                 :      247146 :   bool warning;
     967                 :             : 
     968                 :      247146 :   warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
     969                 :      247146 :   if ((gfc_option.allow_std & std) != 0 && !warning)
     970                 :             :     return SILENT;
     971                 :             : 
     972                 :         385 :   return warning ? WARNING : ERROR;
     973                 :             : }
     974                 :             : 
     975                 :             : 
     976                 :             : /* Return a string describing the nature of a standard violation
     977                 :             :  * and/or the relevant version of the standard.  */
     978                 :             : 
     979                 :             : char const*
     980                 :       16000 : notify_std_msg(int std)
     981                 :             : {
     982                 :             : 
     983                 :       16000 :   if (std & GFC_STD_F2018_DEL)
     984                 :           1 :     return _("Fortran 2018 deleted feature:");
     985                 :       15999 :   else if (std & GFC_STD_F2018_OBS)
     986                 :           7 :     return _("Fortran 2018 obsolescent feature:");
     987                 :       15992 :   else if (std & GFC_STD_F2018)
     988                 :         118 :     return _("Fortran 2018:");
     989                 :       15874 :   else if (std & GFC_STD_F2008_OBS)
     990                 :           2 :     return _("Fortran 2008 obsolescent feature:");
     991                 :       15872 :   else if (std & GFC_STD_F2008)
     992                 :             :     return "Fortran 2008:";
     993                 :       15481 :   else if (std & GFC_STD_F2003)
     994                 :             :     return "Fortran 2003:";
     995                 :       15355 :   else if (std & GFC_STD_GNU)
     996                 :         393 :     return _("GNU Extension:");
     997                 :       14962 :   else if (std & GFC_STD_LEGACY)
     998                 :       11549 :     return _("Legacy Extension:");
     999                 :        3413 :   else if (std & GFC_STD_F95_OBS)
    1000                 :        3283 :     return _("Obsolescent feature:");
    1001                 :         130 :   else if (std & GFC_STD_F95_DEL)
    1002                 :         130 :     return _("Deleted feature:");
    1003                 :             :   else
    1004                 :           0 :     gcc_unreachable ();
    1005                 :             : }
    1006                 :             : 
    1007                 :             : 
    1008                 :             : /* Possibly issue a warning/error about use of a nonstandard (or deleted)
    1009                 :             :    feature.  An error/warning will be issued if the currently selected
    1010                 :             :    standard does not contain the requested bits.  Return false if
    1011                 :             :    an error is generated.  */
    1012                 :             : 
    1013                 :             : bool
    1014                 :      275857 : gfc_notify_std (int std, const char *gmsgid, ...)
    1015                 :             : {
    1016                 :      275857 :   va_list argp;
    1017                 :      275857 :   const char *msg, *msg2;
    1018                 :      275857 :   char *buffer;
    1019                 :             : 
    1020                 :             :   /* Determine whether an error or a warning is needed.  */
    1021                 :      275857 :   const int wstd = std & gfc_option.warn_std;    /* Standard to warn about.  */
    1022                 :      275857 :   const int estd = std & ~gfc_option.allow_std;  /* Standard to error about.  */
    1023                 :      275857 :   const bool warning = (wstd != 0) && !inhibit_warnings;
    1024                 :      275857 :   const bool error = (estd != 0);
    1025                 :             : 
    1026                 :      275857 :   if (!error && !warning)
    1027                 :             :     return true;
    1028                 :       16001 :   if (suppress_errors)
    1029                 :             :     return !error;
    1030                 :             : 
    1031                 :       16000 :   if (error)
    1032                 :         730 :     msg = notify_std_msg (estd);
    1033                 :             :   else
    1034                 :       15270 :     msg = notify_std_msg (wstd);
    1035                 :             : 
    1036                 :       16000 :   msg2 = _(gmsgid);
    1037                 :       16000 :   buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
    1038                 :       16000 :   strcpy (buffer, msg);
    1039                 :       16000 :   strcat (buffer, " ");
    1040                 :       16000 :   strcat (buffer, msg2);
    1041                 :             : 
    1042                 :       16000 :   va_start (argp, gmsgid);
    1043                 :       16000 :   if (error)
    1044                 :         730 :     gfc_error_opt (0, buffer, argp);
    1045                 :             :   else
    1046                 :       15270 :     gfc_warning (0, buffer, argp);
    1047                 :       16000 :   va_end (argp);
    1048                 :             : 
    1049                 :       16000 :   if (error)
    1050                 :             :     return false;
    1051                 :             :   else
    1052                 :       15273 :     return (warning && !warnings_are_errors);
    1053                 :             : }
    1054                 :             : 
    1055                 :             : 
    1056                 :             : /* Called from output_format -- during diagnostic message processing
    1057                 :             :    to handle Fortran specific format specifiers with the following meanings:
    1058                 :             : 
    1059                 :             :    %C  Current locus (no argument)
    1060                 :             :    %L  Takes locus argument
    1061                 :             : */
    1062                 :             : static bool
    1063                 :     1042702 : gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec,
    1064                 :             :                     int precision, bool wide, bool set_locus, bool hash,
    1065                 :             :                     bool *quoted, const char **buffer_ptr)
    1066                 :             : {
    1067                 :     1042702 :   switch (*spec)
    1068                 :             :     {
    1069                 :     1042679 :     case 'C':
    1070                 :     1042679 :     case 'L':
    1071                 :     1042679 :       {
    1072                 :     1042679 :         static const char *result[2] = { "(1)", "(2)" };
    1073                 :     1042679 :         locus *loc;
    1074                 :     1042679 :         if (*spec == 'C')
    1075                 :             :           loc = &gfc_current_locus;
    1076                 :             :         else
    1077                 :       14521 :           loc = va_arg (*text->args_ptr, locus *);
    1078                 :     1042679 :         gcc_assert (loc->nextc - loc->lb->line >= 0);
    1079                 :     1042679 :         unsigned int offset = loc->nextc - loc->lb->line;
    1080                 :     1042679 :         if (*spec == 'C' && *loc->nextc != '\0')
    1081                 :             :           /* Point %C first offending character not the last good one. */
    1082                 :      974476 :           offset++;
    1083                 :             :         /* If location[0] != UNKNOWN_LOCATION means that we already
    1084                 :             :            processed one of %C/%L.  */
    1085                 :     1042679 :         int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
    1086                 :     1042679 :         location_t src_loc
    1087                 :     2085358 :           = linemap_position_for_loc_and_offset (line_table,
    1088                 :     1042679 :                                                  loc->lb->location,
    1089                 :             :                                                  offset);
    1090                 :     1042679 :         text->set_location (loc_num, src_loc, SHOW_RANGE_WITH_CARET);
    1091                 :             :         /* Colorize the markers to match the color choices of
    1092                 :             :            diagnostic_show_locus (the initial location has a color given
    1093                 :             :            by the "kind" of the diagnostic, the secondary location has
    1094                 :             :            color "range1").  */
    1095                 :     1042679 :         gcc_assert (curr_diagnostic != NULL);
    1096                 :     1042679 :         const char *color
    1097                 :             :           = (loc_num
    1098                 :     1042679 :              ? "range1"
    1099                 :     1042246 :              : diagnostic_get_color_for_kind (curr_diagnostic->kind));
    1100                 :     1042679 :         pp_string (pp, colorize_start (pp_show_color (pp), color));
    1101                 :     1042679 :         pp_string (pp, result[loc_num]);
    1102                 :     1042679 :         pp_string (pp, colorize_stop (pp_show_color (pp)));
    1103                 :     1042679 :         return true;
    1104                 :             :       }
    1105                 :          23 :     default:
    1106                 :             :       /* Fall through info the middle-end decoder, as e.g. stor-layout.cc
    1107                 :             :          etc. diagnostics can use the FE printer while the FE is still
    1108                 :             :          active.  */
    1109                 :          23 :       return default_tree_printer (pp, text, spec, precision, wide,
    1110                 :          23 :                                    set_locus, hash, quoted, buffer_ptr);
    1111                 :             :     }
    1112                 :             : }
    1113                 :             : 
    1114                 :             : /* Return a malloc'd string describing the kind of diagnostic.  The
    1115                 :             :    caller is responsible for freeing the memory.  */
    1116                 :             : static char *
    1117                 :     1044919 : gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
    1118                 :             :                                   const diagnostic_info *diagnostic)
    1119                 :             : {
    1120                 :     1044919 :   static const char *const diagnostic_kind_text[] = {
    1121                 :             : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
    1122                 :             : #include "gfc-diagnostic.def"
    1123                 :             : #undef DEFINE_DIAGNOSTIC_KIND
    1124                 :             :     "must-not-happen"
    1125                 :             :   };
    1126                 :     1044919 :   static const char *const diagnostic_kind_color[] = {
    1127                 :             : #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (C),
    1128                 :             : #include "gfc-diagnostic.def"
    1129                 :             : #undef DEFINE_DIAGNOSTIC_KIND
    1130                 :             :     NULL
    1131                 :             :   };
    1132                 :     1044919 :   gcc_assert (diagnostic->kind < DK_LAST_DIAGNOSTIC_KIND);
    1133                 :     1044919 :   const char *text = _(diagnostic_kind_text[diagnostic->kind]);
    1134                 :     1044919 :   const char *text_cs = "", *text_ce = "";
    1135                 :     1044919 :   pretty_printer *pp = context->printer;
    1136                 :             : 
    1137                 :     1044919 :   if (diagnostic_kind_color[diagnostic->kind])
    1138                 :             :     {
    1139                 :     1044919 :       text_cs = colorize_start (pp_show_color (pp),
    1140                 :             :                                 diagnostic_kind_color[diagnostic->kind]);
    1141                 :     1044919 :       text_ce = colorize_stop (pp_show_color (pp));
    1142                 :             :     }
    1143                 :     1044919 :   return build_message_string ("%s%s:%s ", text_cs, text, text_ce);
    1144                 :             : }
    1145                 :             : 
    1146                 :             : /* Return a malloc'd string describing a location.  The caller is
    1147                 :             :    responsible for freeing the memory.  */
    1148                 :             : static char *
    1149                 :     1045059 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
    1150                 :             :                                    expanded_location s)
    1151                 :             : {
    1152                 :     1045059 :   pretty_printer *pp = context->printer;
    1153                 :     1045059 :   const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
    1154                 :     1045059 :   const char *locus_ce = colorize_stop (pp_show_color (pp));
    1155                 :     1045059 :   return (s.file == NULL
    1156                 :     1045059 :           ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
    1157                 :     1044998 :           : !strcmp (s.file, special_fname_builtin ())
    1158                 :     1044998 :           ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
    1159                 :     1044988 :           : context->show_column
    1160                 :     1044988 :           ? build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
    1161                 :             :                                   s.column, locus_ce)
    1162                 :           0 :           : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
    1163                 :             : }
    1164                 :             : 
    1165                 :             : /* Return a malloc'd string describing two locations.  The caller is
    1166                 :             :    responsible for freeing the memory.  */
    1167                 :             : static char *
    1168                 :         146 : gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
    1169                 :             :                                    expanded_location s, expanded_location s2)
    1170                 :             : {
    1171                 :         146 :   pretty_printer *pp = context->printer;
    1172                 :         146 :   const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
    1173                 :         146 :   const char *locus_ce = colorize_stop (pp_show_color (pp));
    1174                 :             : 
    1175                 :         146 :   return (s.file == NULL
    1176                 :         146 :           ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
    1177                 :         146 :           : !strcmp (s.file, special_fname_builtin ())
    1178                 :         146 :           ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
    1179                 :         146 :           : context->show_column
    1180                 :         146 :           ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
    1181                 :             :                                   MIN (s.column, s2.column),
    1182                 :             :                                   MAX (s.column, s2.column), locus_ce)
    1183                 :           0 :           : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
    1184                 :         146 :                                   locus_ce));
    1185                 :             : }
    1186                 :             : 
    1187                 :             : /* This function prints the locus (file:line:column), the diagnostic kind
    1188                 :             :    (Error, Warning) and (optionally) the relevant lines of code with
    1189                 :             :    annotation lines with '1' and/or '2' below them.
    1190                 :             : 
    1191                 :             :    With -fdiagnostic-show-caret (the default) it prints:
    1192                 :             : 
    1193                 :             :        [locus of primary range]:
    1194                 :             : 
    1195                 :             :           some code
    1196                 :             :                  1
    1197                 :             :        Error: Some error at (1)
    1198                 :             : 
    1199                 :             :   With -fno-diagnostic-show-caret or if the primary range is not
    1200                 :             :   valid, it prints:
    1201                 :             : 
    1202                 :             :        [locus of primary range]: Error: Some error at (1) and (2)
    1203                 :             : */
    1204                 :             : static void
    1205                 :     1044919 : gfc_diagnostic_starter (diagnostic_context *context,
    1206                 :             :                         diagnostic_info *diagnostic)
    1207                 :             : {
    1208                 :     1044919 :   char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
    1209                 :             : 
    1210                 :     1044919 :   expanded_location s1 = diagnostic_expand_location (diagnostic);
    1211                 :     1044919 :   expanded_location s2;
    1212                 :     1044919 :   bool one_locus = diagnostic->richloc->get_num_locations () < 2;
    1213                 :     1044919 :   bool same_locus = false;
    1214                 :             : 
    1215                 :     1044919 :   if (!one_locus)
    1216                 :             :     {
    1217                 :         433 :       s2 = diagnostic_expand_location (diagnostic, 1);
    1218                 :         866 :       same_locus = diagnostic_same_line (context, s1, s2);
    1219                 :             :     }
    1220                 :             : 
    1221                 :     1044919 :   char * locus_prefix = (one_locus || !same_locus)
    1222                 :     1044919 :     ? gfc_diagnostic_build_locus_prefix (context, s1)
    1223                 :         146 :     : gfc_diagnostic_build_locus_prefix (context, s1, s2);
    1224                 :             : 
    1225                 :     1044919 :   if (!context->show_caret
    1226                 :       15796 :       || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
    1227                 :     1060715 :       || diagnostic_location (diagnostic, 0) == context->last_location)
    1228                 :             :     {
    1229                 :     1029123 :       pp_set_prefix (context->printer,
    1230                 :             :                      concat (locus_prefix, " ", kind_prefix, NULL));
    1231                 :     1029123 :       free (locus_prefix);
    1232                 :             : 
    1233                 :     1029123 :       if (one_locus || same_locus)
    1234                 :             :         {
    1235                 :     1028838 :           free (kind_prefix);
    1236                 :     1028838 :           return;
    1237                 :             :         }
    1238                 :             :       /* In this case, we print the previous locus and prefix as:
    1239                 :             : 
    1240                 :             :           [locus]:[prefix]: (1)
    1241                 :             : 
    1242                 :             :          and we flush with a new line before setting the new prefix.  */
    1243                 :         285 :       pp_string (context->printer, "(1)");
    1244                 :         285 :       pp_newline (context->printer);
    1245                 :         285 :       locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
    1246                 :         285 :       pp_set_prefix (context->printer,
    1247                 :             :                      concat (locus_prefix, " ", kind_prefix, NULL));
    1248                 :         285 :       free (kind_prefix);
    1249                 :         285 :       free (locus_prefix);
    1250                 :             :     }
    1251                 :             :   else
    1252                 :             :     {
    1253                 :       15796 :       pp_verbatim (context->printer, "%s", locus_prefix);
    1254                 :       15796 :       free (locus_prefix);
    1255                 :             :       /* Fortran uses an empty line between locus and caret line.  */
    1256                 :       15796 :       pp_newline (context->printer);
    1257                 :       15796 :       pp_set_prefix (context->printer, NULL);
    1258                 :       15796 :       pp_newline (context->printer);
    1259                 :       15796 :       diagnostic_show_locus (context, diagnostic->richloc, diagnostic->kind);
    1260                 :             :       /* If the caret line was shown, the prefix does not contain the
    1261                 :             :          locus.  */
    1262                 :       15796 :       pp_set_prefix (context->printer, kind_prefix);
    1263                 :             :     }
    1264                 :             : }
    1265                 :             : 
    1266                 :             : static void
    1267                 :           1 : gfc_diagnostic_start_span (diagnostic_context *context,
    1268                 :             :                            expanded_location exploc)
    1269                 :             : {
    1270                 :           1 :   char *locus_prefix;
    1271                 :           1 :   locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
    1272                 :           1 :   pp_verbatim (context->printer, "%s", locus_prefix);
    1273                 :           1 :   free (locus_prefix);
    1274                 :           1 :   pp_newline (context->printer);
    1275                 :             :   /* Fortran uses an empty line between locus and caret line.  */
    1276                 :           1 :   pp_newline (context->printer);
    1277                 :           1 : }
    1278                 :             : 
    1279                 :             : 
    1280                 :             : static void
    1281                 :     1044919 : gfc_diagnostic_finalizer (diagnostic_context *context,
    1282                 :             :                           diagnostic_info *diagnostic ATTRIBUTE_UNUSED,
    1283                 :             :                           diagnostic_t orig_diag_kind ATTRIBUTE_UNUSED)
    1284                 :             : {
    1285                 :     1044919 :   pp_destroy_prefix (context->printer);
    1286                 :     1044919 :   pp_newline_and_flush (context->printer);
    1287                 :     1044919 : }
    1288                 :             : 
    1289                 :             : /* Immediate warning (i.e. do not buffer the warning) with an explicit
    1290                 :             :    location.  */
    1291                 :             : 
    1292                 :             : bool
    1293                 :           3 : gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
    1294                 :             : {
    1295                 :           3 :   va_list argp;
    1296                 :           3 :   diagnostic_info diagnostic;
    1297                 :           3 :   rich_location rich_loc (line_table, loc);
    1298                 :           3 :   bool ret;
    1299                 :             : 
    1300                 :           3 :   va_start (argp, gmsgid);
    1301                 :           3 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_WARNING);
    1302                 :           3 :   diagnostic.option_index = opt;
    1303                 :           3 :   ret = gfc_report_diagnostic (&diagnostic);
    1304                 :           3 :   va_end (argp);
    1305                 :           6 :   return ret;
    1306                 :           3 : }
    1307                 :             : 
    1308                 :             : /* Immediate warning (i.e. do not buffer the warning).  */
    1309                 :             : 
    1310                 :             : bool
    1311                 :       23095 : gfc_warning_now (int opt, const char *gmsgid, ...)
    1312                 :             : {
    1313                 :       23095 :   va_list argp;
    1314                 :       23095 :   diagnostic_info diagnostic;
    1315                 :       23095 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1316                 :       23095 :   bool ret;
    1317                 :             : 
    1318                 :       23095 :   va_start (argp, gmsgid);
    1319                 :       23095 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
    1320                 :             :                        DK_WARNING);
    1321                 :       23095 :   diagnostic.option_index = opt;
    1322                 :       23095 :   ret = gfc_report_diagnostic (&diagnostic);
    1323                 :       23095 :   va_end (argp);
    1324                 :       46190 :   return ret;
    1325                 :       23095 : }
    1326                 :             : 
    1327                 :             : /* Internal warning, do not buffer.  */
    1328                 :             : 
    1329                 :             : bool
    1330                 :           0 : gfc_warning_internal (int opt, const char *gmsgid, ...)
    1331                 :             : {
    1332                 :           0 :   va_list argp;
    1333                 :           0 :   diagnostic_info diagnostic;
    1334                 :           0 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1335                 :           0 :   bool ret;
    1336                 :             : 
    1337                 :           0 :   va_start (argp, gmsgid);
    1338                 :           0 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
    1339                 :             :                        DK_WARNING);
    1340                 :           0 :   diagnostic.option_index = opt;
    1341                 :           0 :   ret = gfc_report_diagnostic (&diagnostic);
    1342                 :           0 :   va_end (argp);
    1343                 :           0 :   return ret;
    1344                 :           0 : }
    1345                 :             : 
    1346                 :             : /* Immediate error (i.e. do not buffer).  */
    1347                 :             : 
    1348                 :             : void
    1349                 :         383 : gfc_error_now (const char *gmsgid, ...)
    1350                 :             : {
    1351                 :         383 :   va_list argp;
    1352                 :         383 :   diagnostic_info diagnostic;
    1353                 :         383 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1354                 :             : 
    1355                 :         383 :   error_buffer.flag = true;
    1356                 :             : 
    1357                 :         383 :   va_start (argp, gmsgid);
    1358                 :         383 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ERROR);
    1359                 :         383 :   gfc_report_diagnostic (&diagnostic);
    1360                 :         383 :   va_end (argp);
    1361                 :         383 : }
    1362                 :             : 
    1363                 :             : 
    1364                 :             : /* Fatal error, never returns.  */
    1365                 :             : 
    1366                 :             : void
    1367                 :           8 : gfc_fatal_error (const char *gmsgid, ...)
    1368                 :             : {
    1369                 :           8 :   va_list argp;
    1370                 :           8 :   diagnostic_info diagnostic;
    1371                 :           8 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1372                 :             : 
    1373                 :           8 :   va_start (argp, gmsgid);
    1374                 :           8 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_FATAL);
    1375                 :           8 :   gfc_report_diagnostic (&diagnostic);
    1376                 :           0 :   va_end (argp);
    1377                 :             : 
    1378                 :           0 :   gcc_unreachable ();
    1379                 :             : }
    1380                 :             : 
    1381                 :             : /* Clear the warning flag.  */
    1382                 :             : 
    1383                 :             : void
    1384                 :    11538474 : gfc_clear_warning (void)
    1385                 :             : {
    1386                 :    11538474 :   gfc_clear_pp_buffer (pp_warning_buffer);
    1387                 :    11538474 :   warningcount_buffered = 0;
    1388                 :    11538474 :   werrorcount_buffered = 0;
    1389                 :    11538474 : }
    1390                 :             : 
    1391                 :             : 
    1392                 :             : /* Check to see if any warnings have been saved.
    1393                 :             :    If so, print the warning.  */
    1394                 :             : 
    1395                 :             : void
    1396                 :     1118974 : gfc_warning_check (void)
    1397                 :             : {
    1398                 :     1122906 :   if (! gfc_output_buffer_empty_p (pp_warning_buffer))
    1399                 :             :     {
    1400                 :        3932 :       pretty_printer *pp = global_dc->printer;
    1401                 :        3932 :       output_buffer *tmp_buffer = pp->buffer;
    1402                 :        3932 :       pp->buffer = pp_warning_buffer;
    1403                 :        3932 :       pp_really_flush (pp);
    1404                 :        3932 :       warningcount += warningcount_buffered;
    1405                 :        3932 :       werrorcount += werrorcount_buffered;
    1406                 :        3932 :       gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
    1407                 :        3932 :       pp->buffer = tmp_buffer;
    1408                 :        3932 :       diagnostic_action_after_output (global_dc,
    1409                 :             :                                       warningcount_buffered
    1410                 :             :                                       ? DK_WARNING : DK_ERROR);
    1411                 :        3932 :       diagnostic_check_max_errors (global_dc, true);
    1412                 :             :     }
    1413                 :     1118974 : }
    1414                 :             : 
    1415                 :             : 
    1416                 :             : /* Issue an error.  */
    1417                 :             : 
    1418                 :             : static void
    1419                 :     1040666 : gfc_error_opt (int opt, const char *gmsgid, va_list ap)
    1420                 :             : {
    1421                 :     1040666 :   va_list argp;
    1422                 :     1040666 :   va_copy (argp, ap);
    1423                 :     1040666 :   bool saved_abort_on_error = false;
    1424                 :             : 
    1425                 :     1040666 :   if (warnings_not_errors)
    1426                 :             :     {
    1427                 :          44 :       gfc_warning (opt, gmsgid, argp);
    1428                 :          44 :       va_end (argp);
    1429                 :       16837 :       return;
    1430                 :             :     }
    1431                 :             : 
    1432                 :     1040622 :   if (suppress_errors)
    1433                 :             :     {
    1434                 :       16793 :       va_end (argp);
    1435                 :       16793 :       return;
    1436                 :             :     }
    1437                 :             : 
    1438                 :     1023829 :   diagnostic_info diagnostic;
    1439                 :     1023829 :   rich_location richloc (line_table, UNKNOWN_LOCATION);
    1440                 :     1023829 :   bool fatal_errors = global_dc->fatal_errors;
    1441                 :     1023829 :   pretty_printer *pp = global_dc->printer;
    1442                 :     1023829 :   output_buffer *tmp_buffer = pp->buffer;
    1443                 :             : 
    1444                 :     1023829 :   gfc_clear_pp_buffer (pp_error_buffer);
    1445                 :             : 
    1446                 :     1023829 :   if (buffered_p)
    1447                 :             :     {
    1448                 :             :       /* To prevent -dH from triggering an abort on a buffered error,
    1449                 :             :          save abort_on_error and restore it below.  */
    1450                 :     1017515 :       saved_abort_on_error = global_dc->abort_on_error;
    1451                 :     1017515 :       global_dc->abort_on_error = false;
    1452                 :     1017515 :       pp->buffer = pp_error_buffer;
    1453                 :     1017515 :       global_dc->fatal_errors = false;
    1454                 :             :       /* To prevent -fmax-errors= triggering, we decrease it before
    1455                 :             :          report_diagnostic increases it.  */
    1456                 :     1017515 :       --errorcount;
    1457                 :             :     }
    1458                 :             : 
    1459                 :     1023829 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &richloc, DK_ERROR);
    1460                 :     1023829 :   gfc_report_diagnostic (&diagnostic);
    1461                 :             : 
    1462                 :     1023829 :   if (buffered_p)
    1463                 :             :     {
    1464                 :     1017515 :       pp->buffer = tmp_buffer;
    1465                 :     1017515 :       global_dc->fatal_errors = fatal_errors;
    1466                 :     1017515 :       global_dc->abort_on_error = saved_abort_on_error;
    1467                 :             : 
    1468                 :             :     }
    1469                 :             : 
    1470                 :     1023829 :   va_end (argp);
    1471                 :     1023829 : }
    1472                 :             : 
    1473                 :             : 
    1474                 :             : void
    1475                 :         244 : gfc_error_opt (int opt, const char *gmsgid, ...)
    1476                 :             : {
    1477                 :         244 :   va_list argp;
    1478                 :         244 :   va_start (argp, gmsgid);
    1479                 :         244 :   gfc_error_opt (opt, gmsgid, argp);
    1480                 :         244 :   va_end (argp);
    1481                 :         244 : }
    1482                 :             : 
    1483                 :             : 
    1484                 :             : void
    1485                 :     1039692 : gfc_error (const char *gmsgid, ...)
    1486                 :             : {
    1487                 :     1039692 :   va_list argp;
    1488                 :     1039692 :   va_start (argp, gmsgid);
    1489                 :     1039692 :   gfc_error_opt (0, gmsgid, argp);
    1490                 :     1039692 :   va_end (argp);
    1491                 :     1039692 : }
    1492                 :             : 
    1493                 :             : 
    1494                 :             : /* This shouldn't happen... but sometimes does.  */
    1495                 :             : 
    1496                 :             : void
    1497                 :           0 : gfc_internal_error (const char *gmsgid, ...)
    1498                 :             : {
    1499                 :           0 :   int e, w;
    1500                 :           0 :   va_list argp;
    1501                 :           0 :   diagnostic_info diagnostic;
    1502                 :           0 :   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
    1503                 :             : 
    1504                 :           0 :   gfc_get_errors (&w, &e);
    1505                 :           0 :   if (e > 0)
    1506                 :           0 :     exit(EXIT_FAILURE);
    1507                 :             : 
    1508                 :           0 :   va_start (argp, gmsgid);
    1509                 :           0 :   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
    1510                 :           0 :   gfc_report_diagnostic (&diagnostic);
    1511                 :           0 :   va_end (argp);
    1512                 :             : 
    1513                 :           0 :   gcc_unreachable ();
    1514                 :             : }
    1515                 :             : 
    1516                 :             : 
    1517                 :             : /* Clear the error flag when we start to compile a source line.  */
    1518                 :             : 
    1519                 :             : void
    1520                 :     4481630 : gfc_clear_error (void)
    1521                 :             : {
    1522                 :     4481630 :   error_buffer.flag = false;
    1523                 :     4481630 :   warnings_not_errors = false;
    1524                 :     4481630 :   gfc_clear_pp_buffer (pp_error_buffer);
    1525                 :     4481630 : }
    1526                 :             : 
    1527                 :             : 
    1528                 :             : /* Tests the state of error_flag.  */
    1529                 :             : 
    1530                 :             : bool
    1531                 :     1435846 : gfc_error_flag_test (void)
    1532                 :             : {
    1533                 :     1435846 :   return error_buffer.flag
    1534                 :     2378512 :     || !gfc_output_buffer_empty_p (pp_error_buffer);
    1535                 :             : }
    1536                 :             : 
    1537                 :             : 
    1538                 :             : /* Check to see if any errors have been saved.
    1539                 :             :    If so, print the error.  Returns the state of error_flag.  */
    1540                 :             : 
    1541                 :             : bool
    1542                 :        5111 : gfc_error_check (void)
    1543                 :             : {
    1544                 :        5111 :   if (error_buffer.flag
    1545                 :        7985 :       || ! gfc_output_buffer_empty_p (pp_error_buffer))
    1546                 :             :     {
    1547                 :        2896 :       error_buffer.flag = false;
    1548                 :        2896 :       pretty_printer *pp = global_dc->printer;
    1549                 :        2896 :       output_buffer *tmp_buffer = pp->buffer;
    1550                 :        2896 :       pp->buffer = pp_error_buffer;
    1551                 :        2896 :       pp_really_flush (pp);
    1552                 :        2896 :       ++errorcount;
    1553                 :        2896 :       gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
    1554                 :        2896 :       pp->buffer = tmp_buffer;
    1555                 :        2896 :       diagnostic_action_after_output (global_dc, DK_ERROR);
    1556                 :        2896 :       diagnostic_check_max_errors (global_dc, true);
    1557                 :        2896 :       return true;
    1558                 :             :     }
    1559                 :             : 
    1560                 :             :   return false;
    1561                 :             : }
    1562                 :             : 
    1563                 :             : /* Move the text buffered from FROM to TO, then clear
    1564                 :             :    FROM. Independently if there was text in FROM, TO is also
    1565                 :             :    cleared. */
    1566                 :             : 
    1567                 :             : static void
    1568                 :     2585926 : gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
    1569                 :             :                                gfc_error_buffer * buffer_to)
    1570                 :             : {
    1571                 :     2585926 :   output_buffer * from = &(buffer_from->buffer);
    1572                 :     2585926 :   output_buffer * to =  &(buffer_to->buffer);
    1573                 :             : 
    1574                 :     2585926 :   buffer_to->flag = buffer_from->flag;
    1575                 :     2585926 :   buffer_from->flag = false;
    1576                 :             : 
    1577                 :     2585926 :   gfc_clear_pp_buffer (to);
    1578                 :             :   /* We make sure this is always buffered.  */
    1579                 :     2585926 :   to->flush_p = false;
    1580                 :             : 
    1581                 :     2672694 :   if (! gfc_output_buffer_empty_p (from))
    1582                 :             :     {
    1583                 :       86768 :       const char *str = output_buffer_formatted_text (from);
    1584                 :       86768 :       output_buffer_append_r (to, str, strlen (str));
    1585                 :       86768 :       gfc_clear_pp_buffer (from);
    1586                 :             :     }
    1587                 :     2585926 : }
    1588                 :             : 
    1589                 :             : /* Save the existing error state.  */
    1590                 :             : 
    1591                 :             : void
    1592                 :     1318779 : gfc_push_error (gfc_error_buffer *err)
    1593                 :             : {
    1594                 :     1318779 :   gfc_move_error_buffer_from_to (&error_buffer, err);
    1595                 :     1318779 : }
    1596                 :             : 
    1597                 :             : 
    1598                 :             : /* Restore a previous pushed error state.  */
    1599                 :             : 
    1600                 :             : void
    1601                 :     1267147 : gfc_pop_error (gfc_error_buffer *err)
    1602                 :             : {
    1603                 :     1267147 :   gfc_move_error_buffer_from_to (err, &error_buffer);
    1604                 :     1267147 : }
    1605                 :             : 
    1606                 :             : 
    1607                 :             : /* Free a pushed error state, but keep the current error state.  */
    1608                 :             : 
    1609                 :             : void
    1610                 :       51520 : gfc_free_error (gfc_error_buffer *err)
    1611                 :             : {
    1612                 :       51520 :   gfc_clear_pp_buffer (&(err->buffer));
    1613                 :       51520 : }
    1614                 :             : 
    1615                 :             : 
    1616                 :             : /* Report the number of warnings and errors that occurred to the caller.  */
    1617                 :             : 
    1618                 :             : void
    1619                 :      300311 : gfc_get_errors (int *w, int *e)
    1620                 :             : {
    1621                 :      300311 :   if (w != NULL)
    1622                 :      253527 :     *w = warningcount + werrorcount;
    1623                 :      300311 :   if (e != NULL)
    1624                 :      300311 :     *e = errorcount + sorrycount + werrorcount;
    1625                 :      300311 : }
    1626                 :             : 
    1627                 :             : 
    1628                 :             : /* Switch errors into warnings.  */
    1629                 :             : 
    1630                 :             : void
    1631                 :       46082 : gfc_errors_to_warnings (bool f)
    1632                 :             : {
    1633                 :       46082 :   warnings_not_errors = f;
    1634                 :       46082 : }
    1635                 :             : 
    1636                 :             : void
    1637                 :       29018 : gfc_diagnostics_init (void)
    1638                 :             : {
    1639                 :       29018 :   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
    1640                 :       29018 :   global_dc->start_span = gfc_diagnostic_start_span;
    1641                 :       29018 :   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
    1642                 :       29018 :   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
    1643                 :       29018 :   global_dc->caret_chars[0] = '1';
    1644                 :       29018 :   global_dc->caret_chars[1] = '2';
    1645                 :       29018 :   pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
    1646                 :       29018 :   pp_warning_buffer->flush_p = false;
    1647                 :             :   /* pp_error_buffer is statically allocated.  This simplifies memory
    1648                 :             :      management when using gfc_push/pop_error. */
    1649                 :       29018 :   pp_error_buffer = &(error_buffer.buffer);
    1650                 :       29018 :   pp_error_buffer->flush_p = false;
    1651                 :       29018 : }
    1652                 :             : 
    1653                 :             : void
    1654                 :       28992 : gfc_diagnostics_finish (void)
    1655                 :             : {
    1656                 :       28992 :   tree_diagnostics_defaults (global_dc);
    1657                 :             :   /* We still want to use the gfc starter and finalizer, not the tree
    1658                 :             :      defaults.  */
    1659                 :       28992 :   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
    1660                 :       28992 :   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
    1661                 :       28992 :   global_dc->caret_chars[0] = '^';
    1662                 :       28992 :   global_dc->caret_chars[1] = '^';
    1663                 :       28992 : }
        

Generated by: LCOV version 2.0-1

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.