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

Generated by: LCOV version 1.0

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 --enable-host-shared. GCC test suite is run with the built compiler.