LCOV - code coverage report
Current view: top level - gcc/fortran - scanner.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 97.9 % 1364 1335
Test Date: 2025-04-19 15:48:17 Functions: 96.8 % 62 60
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* Character scanner.
       2                 :             :    Copyright (C) 2000-2025 Free Software Foundation, Inc.
       3                 :             :    Contributed by Andy Vaught
       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                 :             : /* Set of subroutines to (ultimately) return the next character to the
      22                 :             :    various matching subroutines.  This file's job is to read files and
      23                 :             :    build up lines that are parsed by the parser.  This means that we
      24                 :             :    handle continuation lines and "include" lines.
      25                 :             : 
      26                 :             :    The first thing the scanner does is to load an entire file into
      27                 :             :    memory.  We load the entire file into memory for a couple reasons.
      28                 :             :    The first is that we want to be able to deal with nonseekable input
      29                 :             :    (pipes, stdin) and there is a lot of backing up involved during
      30                 :             :    parsing.
      31                 :             : 
      32                 :             :    The second is that we want to be able to print the locus of errors,
      33                 :             :    and an error on line 999999 could conflict with something on line
      34                 :             :    one.  Given nonseekable input, we've got to store the whole thing.
      35                 :             : 
      36                 :             :    One thing that helps are the column truncation limits that give us
      37                 :             :    an upper bound on the size of individual lines.  We don't store the
      38                 :             :    truncated stuff.
      39                 :             : 
      40                 :             :    From the scanner's viewpoint, the higher level subroutines ask for
      41                 :             :    new characters and do a lot of jumping backwards.  */
      42                 :             : 
      43                 :             : #include "config.h"
      44                 :             : #include "system.h"
      45                 :             : #include "coretypes.h"
      46                 :             : #include "gfortran.h"
      47                 :             : #include "toplev.h"   /* For set_src_pwd.  */
      48                 :             : #include "debug.h"
      49                 :             : #include "options.h"
      50                 :             : #include "diagnostic-core.h"  /* For fatal_error. */
      51                 :             : #include "cpp.h"
      52                 :             : #include "scanner.h"
      53                 :             : 
      54                 :             : /* List of include file search directories.  */
      55                 :             : gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
      56                 :             : 
      57                 :             : static gfc_file *file_head, *current_file;
      58                 :             : 
      59                 :             : static bool continue_flag, end_flag, gcc_attribute_flag;
      60                 :             : /* If !$omp/!$acc occurred in current comment line.  */
      61                 :             : static int openmp_flag, openacc_flag;
      62                 :             : static int continue_count, continue_line;
      63                 :             : static locus openmp_locus;
      64                 :             : static locus openacc_locus;
      65                 :             : static locus gcc_attribute_locus;
      66                 :             : 
      67                 :             : gfc_source_form gfc_current_form;
      68                 :             : static gfc_linebuf *line_head, *line_tail;
      69                 :             : 
      70                 :             : locus gfc_current_locus;
      71                 :             : const char *gfc_source_file;
      72                 :             : static FILE *gfc_src_file;
      73                 :             : static gfc_char_t *gfc_src_preprocessor_lines[2];
      74                 :             : 
      75                 :             : static struct gfc_file_change
      76                 :             : {
      77                 :             :   const char *filename;
      78                 :             :   gfc_linebuf *lb;
      79                 :             :   int line;
      80                 :             : } *file_changes;
      81                 :             : static size_t file_changes_cur, file_changes_count;
      82                 :             : static size_t file_changes_allocated;
      83                 :             : 
      84                 :             : static gfc_char_t *last_error_char;
      85                 :             : 
      86                 :             : /* Functions dealing with our wide characters (gfc_char_t) and
      87                 :             :    sequences of such characters.  */
      88                 :             : 
      89                 :             : bool
      90                 :  1281869737 : gfc_wide_fits_in_byte (gfc_char_t c)
      91                 :             : {
      92                 :  1281869737 :   return (c <= UCHAR_MAX);
      93                 :             : }
      94                 :             : 
      95                 :             : static inline int
      96                 :   649426558 : wide_is_ascii (gfc_char_t c)
      97                 :             : {
      98                 :   649426558 :   return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
      99                 :             : }
     100                 :             : 
     101                 :             : bool
     102                 :       29901 : gfc_wide_is_printable (gfc_char_t c)
     103                 :             : {
     104                 :       29901 :   return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
     105                 :             : }
     106                 :             : 
     107                 :             : gfc_char_t
     108                 :   649297014 : gfc_wide_tolower (gfc_char_t c)
     109                 :             : {
     110                 :   649297014 :   return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
     111                 :             : }
     112                 :             : 
     113                 :             : gfc_char_t
     114                 :      129544 : gfc_wide_toupper (gfc_char_t c)
     115                 :             : {
     116                 :      129544 :   return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c) : c);
     117                 :             : }
     118                 :             : 
     119                 :             : bool
     120                 :    11971980 : gfc_wide_is_digit (gfc_char_t c)
     121                 :             : {
     122                 :    11971980 :   return (c >= '0' && c <= '9');
     123                 :             : }
     124                 :             : 
     125                 :             : static inline int
     126                 :       13151 : wide_atoi (gfc_char_t *c)
     127                 :             : {
     128                 :             : #define MAX_DIGITS 20
     129                 :       13151 :   char buf[MAX_DIGITS+1];
     130                 :       13151 :   int i = 0;
     131                 :             : 
     132                 :       28482 :   while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
     133                 :       15331 :     buf[i++] = *c++;
     134                 :       13151 :   buf[i] = '\0';
     135                 :       13151 :   return atoi (buf);
     136                 :             : }
     137                 :             : 
     138                 :             : size_t
     139                 :     6600114 : gfc_wide_strlen (const gfc_char_t *str)
     140                 :             : {
     141                 :     6600114 :   size_t i;
     142                 :             : 
     143                 :   294624317 :   for (i = 0; str[i]; i++)
     144                 :             :     ;
     145                 :             : 
     146                 :     6600114 :   return i;
     147                 :             : }
     148                 :             : 
     149                 :             : gfc_char_t *
     150                 :      336904 : gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len)
     151                 :             : {
     152                 :      336904 :   size_t i;
     153                 :             : 
     154                 :     3004869 :   for (i = 0; i < len; i++)
     155                 :     2667965 :     b[i] = c;
     156                 :             : 
     157                 :      336904 :   return b;
     158                 :             : }
     159                 :             : 
     160                 :             : static gfc_char_t *
     161                 :     6512983 : wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
     162                 :             : {
     163                 :     6512983 :   gfc_char_t *d;
     164                 :             : 
     165                 :   293573020 :   for (d = dest; (*d = *src) != '\0'; ++src, ++d)
     166                 :             :     ;
     167                 :             : 
     168                 :     6512983 :   return dest;
     169                 :             : }
     170                 :             : 
     171                 :             : static gfc_char_t *
     172                 :           0 : wide_strchr (const gfc_char_t *s, gfc_char_t c)
     173                 :             : {
     174                 :       37372 :   do {
     175                 :       37372 :     if (*s == c)
     176                 :             :       {
     177                 :             :         return CONST_CAST(gfc_char_t *, s);
     178                 :             :       }
     179                 :       24221 :   } while (*s++);
     180                 :             :   return 0;
     181                 :             : }
     182                 :             : 
     183                 :             : char *
     184                 :       10546 : gfc_widechar_to_char (const gfc_char_t *s, int length)
     185                 :             : {
     186                 :       10546 :   size_t len, i;
     187                 :       10546 :   char *res;
     188                 :             : 
     189                 :       10546 :   if (s == NULL)
     190                 :             :     return NULL;
     191                 :             : 
     192                 :             :   /* Passing a negative length is used to indicate that length should be
     193                 :             :      calculated using gfc_wide_strlen().  */
     194                 :       10546 :   len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s));
     195                 :       10546 :   res = XNEWVEC (char, len + 1);
     196                 :             : 
     197                 :      456201 :   for (i = 0; i < len; i++)
     198                 :             :     {
     199                 :      435109 :       gcc_assert (gfc_wide_fits_in_byte (s[i]));
     200                 :      435109 :       res[i] = (unsigned char) s[i];
     201                 :             :     }
     202                 :             : 
     203                 :       10546 :   res[len] = '\0';
     204                 :       10546 :   return res;
     205                 :             : }
     206                 :             : 
     207                 :             : gfc_char_t *
     208                 :        2619 : gfc_char_to_widechar (const char *s)
     209                 :             : {
     210                 :        2619 :   size_t len, i;
     211                 :        2619 :   gfc_char_t *res;
     212                 :             : 
     213                 :        2619 :   if (s == NULL)
     214                 :             :     return NULL;
     215                 :             : 
     216                 :        2619 :   len = strlen (s);
     217                 :        2619 :   res = gfc_get_wide_string (len + 1);
     218                 :             : 
     219                 :       43638 :   for (i = 0; i < len; i++)
     220                 :       38400 :     res[i] = (unsigned char) s[i];
     221                 :             : 
     222                 :        2619 :   res[len] = '\0';
     223                 :        2619 :   return res;
     224                 :             : }
     225                 :             : 
     226                 :             : static int
     227                 :          83 : wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
     228                 :             : {
     229                 :          83 :   gfc_char_t c1, c2;
     230                 :             : 
     231                 :         296 :   while (n-- > 0)
     232                 :             :     {
     233                 :         274 :       c1 = *s1++;
     234                 :         274 :       c2 = *s2++;
     235                 :         274 :       if (c1 != c2)
     236                 :         116 :         return (c1 > c2 ? 1 : -1);
     237                 :         213 :       if (c1 == '\0')
     238                 :             :         return 0;
     239                 :             :     }
     240                 :             :   return 0;
     241                 :             : }
     242                 :             : 
     243                 :             : int
     244                 :     6183287 : gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
     245                 :             : {
     246                 :     6183287 :   gfc_char_t c1, c2;
     247                 :             : 
     248                 :     6681866 :   while (n-- > 0)
     249                 :             :     {
     250                 :     6673083 :       c1 = gfc_wide_tolower (*s1++);
     251                 :     6673083 :       c2 = TOLOWER (*s2++);
     252                 :     6673083 :       if (c1 != c2)
     253                 :    11836806 :         return (c1 > c2 ? 1 : -1);
     254                 :      498579 :       if (c1 == '\0')
     255                 :             :         return 0;
     256                 :             :     }
     257                 :             :   return 0;
     258                 :             : }
     259                 :             : 
     260                 :             : 
     261                 :             : /* Main scanner initialization.  */
     262                 :             : 
     263                 :             : void
     264                 :       30444 : gfc_scanner_init_1 (void)
     265                 :             : {
     266                 :       30444 :   file_head = NULL;
     267                 :       30444 :   line_head = NULL;
     268                 :       30444 :   line_tail = NULL;
     269                 :             : 
     270                 :       30444 :   continue_count = 0;
     271                 :       30444 :   continue_line = 0;
     272                 :             : 
     273                 :       30444 :   end_flag = 0;
     274                 :       30444 :   last_error_char = NULL;
     275                 :       30444 : }
     276                 :             : 
     277                 :             : 
     278                 :             : /* Main scanner destructor.  */
     279                 :             : 
     280                 :             : void
     281                 :       30427 : gfc_scanner_done_1 (void)
     282                 :             : {
     283                 :       30427 :   gfc_linebuf *lb;
     284                 :       30427 :   gfc_file *f;
     285                 :             : 
     286                 :     6540867 :   while(line_head != NULL)
     287                 :             :     {
     288                 :     6510440 :       lb = line_head->next;
     289                 :     6510440 :       free (line_head);
     290                 :     6510440 :       line_head = lb;
     291                 :             :     }
     292                 :             : 
     293                 :       93745 :   while(file_head != NULL)
     294                 :             :     {
     295                 :       63318 :       f = file_head->next;
     296                 :       63318 :       free (file_head->filename);
     297                 :       63318 :       free (file_head);
     298                 :       63318 :       file_head = f;
     299                 :             :     }
     300                 :       30427 : }
     301                 :             : 
     302                 :             : static bool
     303                 :      120205 : gfc_do_check_include_dir (const char *path, bool warn)
     304                 :             : {
     305                 :      120205 :   struct stat st;
     306                 :      120205 :   if (stat (path, &st))
     307                 :             :     {
     308                 :       60865 :       if (errno != ENOENT)
     309                 :           0 :         gfc_warning_now (0, "Include directory %qs: %s",
     310                 :             :                          path, xstrerror(errno));
     311                 :       60865 :       else if (warn)
     312                 :          14 :           gfc_warning_now (OPT_Wmissing_include_dirs,
     313                 :             :                            "Nonexistent include directory %qs", path);
     314                 :       60865 :       return false;
     315                 :             :     }
     316                 :       59340 :   else if (!S_ISDIR (st.st_mode))
     317                 :             :     {
     318                 :           1 :       gfc_fatal_error ("%qs is not a directory", path);
     319                 :             :       return false;
     320                 :             :     }
     321                 :             :   return true;
     322                 :             : }
     323                 :             : 
     324                 :             : /* In order that -W(no-)missing-include-dirs works, the diagnostic can only be
     325                 :             :    run after processing the commandline.  */
     326                 :             : static void
     327                 :       60892 : gfc_do_check_include_dirs (gfc_directorylist **list, bool do_warn)
     328                 :             : {
     329                 :       60892 :   gfc_directorylist *prev, *q, *n;
     330                 :       60892 :   prev = NULL;
     331                 :       60892 :   n = *list;
     332                 :      116560 :   while (n)
     333                 :             :     {
     334                 :       55669 :       q = n; n = n->next;
     335                 :       93427 :       if (gfc_do_check_include_dir (q->path, q->warn && do_warn))
     336                 :             :         {
     337                 :       25230 :           prev = q;
     338                 :       25230 :           continue;
     339                 :             :         }
     340                 :       30438 :       if (prev == NULL)
     341                 :       25970 :         *list = n;
     342                 :             :       else
     343                 :        4468 :         prev->next = n;
     344                 :       30438 :       free (q->path);
     345                 :       30438 :       free (q);
     346                 :             :     }
     347                 :       60891 : }
     348                 :             : 
     349                 :             : void
     350                 :       30445 : gfc_check_include_dirs (bool verbose_missing_dir_warn)
     351                 :             : {
     352                 :             :   /* This is a bit convoluted: If gfc_cpp_enabled () and
     353                 :             :      verbose_missing_dir_warn, the warning is shown by libcpp. Otherwise,
     354                 :             :      it is shown here, still conditional on OPT_Wmissing_include_dirs.  */
     355                 :       30445 :   bool warn = !gfc_cpp_enabled () || !verbose_missing_dir_warn;
     356                 :       30445 :   gfc_do_check_include_dirs (&include_dirs, warn);
     357                 :       30444 :   gfc_do_check_include_dirs (&intrinsic_modules_dirs, verbose_missing_dir_warn);
     358                 :       30444 :   if (gfc_option.module_dir && gfc_cpp_enabled ())
     359                 :           3 :     gfc_do_check_include_dirs (&include_dirs, true);
     360                 :       30444 : }
     361                 :             : 
     362                 :             : /* Adds path to the list pointed to by list.  */
     363                 :             : 
     364                 :             : static void
     365                 :      116539 : add_path_to_list (gfc_directorylist **list, const char *path,
     366                 :             :                   bool use_for_modules, bool head, bool warn, bool defer_warn)
     367                 :             : {
     368                 :      116539 :   gfc_directorylist *dir;
     369                 :      116539 :   const char *p;
     370                 :      116539 :   char *q;
     371                 :      116539 :   size_t len;
     372                 :      116539 :   int i;
     373                 :             : 
     374                 :      116539 :   p = path;
     375                 :      116539 :   while (*p == ' ' || *p == '\t')  /* someone might do "-I include" */
     376                 :           0 :     if (*p++ == '\0')
     377                 :             :       return;
     378                 :             : 
     379                 :             :   /* Strip trailing directory separators from the path, as this
     380                 :             :      will confuse Windows systems.  */
     381                 :      116539 :   len = strlen (p);
     382                 :      116539 :   q = (char *) alloca (len + 1);
     383                 :      116539 :   memcpy (q, p, len + 1);
     384                 :      116539 :   i = len - 1;
     385                 :      117064 :   while (i >=0 && IS_DIR_SEPARATOR (q[i]))
     386                 :         525 :     q[i--] = '\0';
     387                 :             : 
     388                 :      116539 :   if (!defer_warn && !gfc_do_check_include_dir (q, warn))
     389                 :             :     return;
     390                 :             : 
     391                 :       86112 :   if (head || *list == NULL)
     392                 :             :     {
     393                 :       64534 :       dir = XCNEW (gfc_directorylist);
     394                 :       64534 :       if (!head)
     395                 :       34092 :         *list = dir;
     396                 :             :     }
     397                 :             :   else
     398                 :             :     {
     399                 :             :       dir = *list;
     400                 :       79854 :       while (dir->next)
     401                 :             :         dir = dir->next;
     402                 :             : 
     403                 :       21578 :       dir->next = XCNEW (gfc_directorylist);
     404                 :       21578 :       dir = dir->next;
     405                 :             :     }
     406                 :             : 
     407                 :       55670 :   dir->next = head ? *list : NULL;
     408                 :       55670 :   if (head)
     409                 :       30442 :     *list = dir;
     410                 :       86112 :   dir->use_for_modules = use_for_modules;
     411                 :       86112 :   dir->warn = warn;
     412                 :       86112 :   dir->path = xstrdup (p);
     413                 :             : }
     414                 :             : 
     415                 :             : /* defer_warn is set to true while parsing the commandline.  */
     416                 :             : 
     417                 :             : void
     418                 :       82447 : gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir,
     419                 :             :                       bool warn, bool defer_warn)
     420                 :             : {
     421                 :       82447 :   add_path_to_list (&include_dirs, path, use_for_modules, file_dir, warn,
     422                 :             :                     defer_warn);
     423                 :             : 
     424                 :             :   /* For '#include "..."' these directories are automatically searched.  */
     425                 :       82447 :   if (!file_dir)
     426                 :       52003 :     gfc_cpp_add_include_path (xstrdup(path), true);
     427                 :       82447 : }
     428                 :             : 
     429                 :             : 
     430                 :             : void
     431                 :       34092 : gfc_add_intrinsic_modules_path (const char *path)
     432                 :             : {
     433                 :       34092 :   add_path_to_list (&intrinsic_modules_dirs, path, true, false, false, false);
     434                 :       34092 : }
     435                 :             : 
     436                 :             : 
     437                 :             : /* Release resources allocated for options.  */
     438                 :             : 
     439                 :             : void
     440                 :       30427 : gfc_release_include_path (void)
     441                 :             : {
     442                 :       30427 :   gfc_directorylist *p;
     443                 :             : 
     444                 :       82415 :   while (include_dirs != NULL)
     445                 :             :     {
     446                 :       51988 :       p = include_dirs;
     447                 :       51988 :       include_dirs = include_dirs->next;
     448                 :       51988 :       free (p->path);
     449                 :       51988 :       free (p);
     450                 :             :     }
     451                 :             : 
     452                 :       34094 :   while (intrinsic_modules_dirs != NULL)
     453                 :             :     {
     454                 :        3667 :       p = intrinsic_modules_dirs;
     455                 :        3667 :       intrinsic_modules_dirs = intrinsic_modules_dirs->next;
     456                 :        3667 :       free (p->path);
     457                 :        3667 :       free (p);
     458                 :             :     }
     459                 :             : 
     460                 :       30427 :   free (gfc_option.module_dir);
     461                 :       30427 : }
     462                 :             : 
     463                 :             : 
     464                 :             : static FILE *
     465                 :         372 : open_included_file (const char *name, gfc_directorylist *list,
     466                 :             :                     bool module, bool system)
     467                 :             : {
     468                 :         372 :   char *fullname;
     469                 :         372 :   gfc_directorylist *p;
     470                 :         372 :   FILE *f;
     471                 :             : 
     472                 :         636 :   for (p = list; p; p = p->next)
     473                 :             :     {
     474                 :         634 :       if (module && !p->use_for_modules)
     475                 :           0 :         continue;
     476                 :             : 
     477                 :         634 :       fullname = (char *) alloca(strlen (p->path) + strlen (name) + 2);
     478                 :         634 :       strcpy (fullname, p->path);
     479                 :         634 :       strcat (fullname, "/");
     480                 :         634 :       strcat (fullname, name);
     481                 :             : 
     482                 :         634 :       f = gfc_open_file (fullname);
     483                 :         634 :       if (f != NULL)
     484                 :             :         {
     485                 :         370 :           if (gfc_cpp_makedep ())
     486                 :           0 :             gfc_cpp_add_dep (fullname, system);
     487                 :             : 
     488                 :         370 :           return f;
     489                 :             :         }
     490                 :             :     }
     491                 :             : 
     492                 :             :   return NULL;
     493                 :             : }
     494                 :             : 
     495                 :             : 
     496                 :             : /* Opens file for reading, searching through the include directories
     497                 :             :    given if necessary.  If the include_cwd argument is true, we try
     498                 :             :    to open the file in the current directory first.  */
     499                 :             : 
     500                 :             : FILE *
     501                 :       30796 : gfc_open_included_file (const char *name, bool include_cwd, bool module)
     502                 :             : {
     503                 :       30796 :   FILE *f = NULL;
     504                 :             : 
     505                 :       30796 :   if (IS_ABSOLUTE_PATH (name) || include_cwd)
     506                 :             :     {
     507                 :       30425 :       f = gfc_open_file (name);
     508                 :       30425 :       if (f && gfc_cpp_makedep ())
     509                 :           0 :         gfc_cpp_add_dep (name, false);
     510                 :             :     }
     511                 :             : 
     512                 :       30425 :   if (!f)
     513                 :         372 :     f = open_included_file (name, include_dirs, module, false);
     514                 :             : 
     515                 :       30796 :   return f;
     516                 :             : }
     517                 :             : 
     518                 :             : 
     519                 :             : /* Test to see if we're at the end of the main source file.  */
     520                 :             : 
     521                 :             : bool
     522                 :  1148070408 : gfc_at_end (void)
     523                 :             : {
     524                 :  1148070408 :   return end_flag;
     525                 :             : }
     526                 :             : 
     527                 :             : 
     528                 :             : /* Test to see if we're at the end of the current file.  */
     529                 :             : 
     530                 :             : bool
     531                 :    30554731 : gfc_at_eof (void)
     532                 :             : {
     533                 :    30554731 :   if (gfc_at_end ())
     534                 :             :     return 1;
     535                 :             : 
     536                 :    30284859 :   if (line_head == NULL)
     537                 :             :     return 1;                   /* Null file */
     538                 :             : 
     539                 :    30284859 :   if (gfc_current_locus.u.lb == NULL)
     540                 :           0 :     return 1;
     541                 :             : 
     542                 :             :   return 0;
     543                 :             : }
     544                 :             : 
     545                 :             : 
     546                 :             : /* Test to see if we're at the beginning of a new line.  */
     547                 :             : 
     548                 :             : bool
     549                 :    14451390 : gfc_at_bol (void)
     550                 :             : {
     551                 :    14451390 :   if (gfc_at_eof ())
     552                 :             :     return 1;
     553                 :             : 
     554                 :    14332250 :   return (gfc_current_locus.nextc == gfc_current_locus.u.lb->line);
     555                 :             : }
     556                 :             : 
     557                 :             : 
     558                 :             : /* Test to see if we're at the end of a line.  */
     559                 :             : 
     560                 :             : bool
     561                 :     4667580 : gfc_at_eol (void)
     562                 :             : {
     563                 :     4667580 :   if (gfc_at_eof ())
     564                 :             :     return 1;
     565                 :             : 
     566                 :     4667576 :   return (*gfc_current_locus.nextc == '\0');
     567                 :             : }
     568                 :             : 
     569                 :             : static void
     570                 :       65842 : add_file_change (const char *filename, int line)
     571                 :             : {
     572                 :       65842 :   if (file_changes_count == file_changes_allocated)
     573                 :             :     {
     574                 :       30430 :       if (file_changes_allocated)
     575                 :           1 :         file_changes_allocated *= 2;
     576                 :             :       else
     577                 :       30429 :         file_changes_allocated = 16;
     578                 :       30430 :       file_changes = XRESIZEVEC (struct gfc_file_change, file_changes,
     579                 :             :                                  file_changes_allocated);
     580                 :             :     }
     581                 :       65842 :   file_changes[file_changes_count].filename = filename;
     582                 :       65842 :   file_changes[file_changes_count].lb = NULL;
     583                 :       65842 :   file_changes[file_changes_count++].line = line;
     584                 :       65842 : }
     585                 :             : 
     586                 :             : static void
     587                 :     6542922 : report_file_change (gfc_linebuf *lb)
     588                 :             : {
     589                 :     6542922 :   size_t c = file_changes_cur;
     590                 :     6542922 :   while (c < file_changes_count
     591                 :     6608758 :          && file_changes[c].lb == lb)
     592                 :             :     {
     593                 :       65836 :       if (file_changes[c].filename)
     594                 :       32918 :         (*debug_hooks->start_source_file) (file_changes[c].line,
     595                 :             :                                            file_changes[c].filename);
     596                 :             :       else
     597                 :       32918 :         (*debug_hooks->end_source_file) (file_changes[c].line);
     598                 :       65836 :       ++c;
     599                 :             :     }
     600                 :     6542922 :   file_changes_cur = c;
     601                 :     6542922 : }
     602                 :             : 
     603                 :             : void
     604                 :       30428 : gfc_start_source_files (void)
     605                 :             : {
     606                 :             :   /* If the debugger wants the name of the main source file,
     607                 :             :      we give it.  */
     608                 :       30428 :   if (debug_hooks->start_end_main_source_file)
     609                 :        5012 :     (*debug_hooks->start_source_file) (0, gfc_source_file);
     610                 :             : 
     611                 :       30428 :   file_changes_cur = 0;
     612                 :       30428 :   report_file_change (gfc_current_locus.u.lb);
     613                 :       30428 : }
     614                 :             : 
     615                 :             : void
     616                 :       30384 : gfc_end_source_files (void)
     617                 :             : {
     618                 :       30384 :   report_file_change (NULL);
     619                 :             : 
     620                 :       30384 :   if (debug_hooks->start_end_main_source_file)
     621                 :        5012 :     (*debug_hooks->end_source_file) (0);
     622                 :       30384 : }
     623                 :             : 
     624                 :             : /* Advance the current line pointer to the next line.  */
     625                 :             : 
     626                 :             : void
     627                 :    10993639 : gfc_advance_line (void)
     628                 :             : {
     629                 :    10993639 :   if (gfc_at_end ())
     630                 :             :     return;
     631                 :             : 
     632                 :    10993629 :   if (gfc_current_locus.u.lb == NULL)
     633                 :             :     {
     634                 :           0 :       end_flag = 1;
     635                 :           0 :       return;
     636                 :             :     }
     637                 :             : 
     638                 :    10993629 :   if (gfc_current_locus.u.lb->next
     639                 :    10842952 :       && !gfc_current_locus.u.lb->next->dbg_emitted)
     640                 :             :     {
     641                 :     6482110 :       report_file_change (gfc_current_locus.u.lb->next);
     642                 :     6482110 :       gfc_current_locus.u.lb->next->dbg_emitted = true;
     643                 :             :     }
     644                 :             : 
     645                 :    10993629 :   gfc_current_locus.u.lb = gfc_current_locus.u.lb->next;
     646                 :             : 
     647                 :    10993629 :   if (gfc_current_locus.u.lb != NULL)
     648                 :    10842952 :     gfc_current_locus.nextc = gfc_current_locus.u.lb->line;
     649                 :             :   else
     650                 :             :     {
     651                 :      150677 :       gfc_current_locus.nextc = NULL;
     652                 :      150677 :       end_flag = 1;
     653                 :             :     }
     654                 :             : }
     655                 :             : 
     656                 :             : 
     657                 :             : /* Get the next character from the input, advancing gfc_current_file's
     658                 :             :    locus.  When we hit the end of the line or the end of the file, we
     659                 :             :    start returning a '\n' in order to complete the current statement.
     660                 :             :    No Fortran line conventions are implemented here.
     661                 :             : 
     662                 :             :    Requiring explicit advances to the next line prevents the parse
     663                 :             :    pointer from being on the wrong line if the current statement ends
     664                 :             :    prematurely.  */
     665                 :             : 
     666                 :             : static gfc_char_t
     667                 :  1321929940 : next_char (void)
     668                 :             : {
     669                 :  1321929940 :   gfc_char_t c;
     670                 :             : 
     671                 :  1321929940 :   if (gfc_current_locus.nextc == NULL)
     672                 :             :     return '\n';
     673                 :             : 
     674                 :  1321809723 :   c = *gfc_current_locus.nextc++;
     675                 :  1321809723 :   if (c == '\0')
     676                 :             :     {
     677                 :    40810767 :       gfc_current_locus.nextc--; /* Remain on this line.  */
     678                 :    40810767 :       c = '\n';
     679                 :             :     }
     680                 :             : 
     681                 :             :   return c;
     682                 :             : }
     683                 :             : 
     684                 :             : 
     685                 :             : /* Skip a comment.  When we come here the parse pointer is positioned
     686                 :             :    immediately after the comment character.  If we ever implement
     687                 :             :    compiler directives within comments, here is where we parse the
     688                 :             :    directive.  */
     689                 :             : 
     690                 :             : static void
     691                 :     1347992 : skip_comment_line (void)
     692                 :             : {
     693                 :    79585995 :   gfc_char_t c;
     694                 :             : 
     695                 :    79585995 :   do
     696                 :             :     {
     697                 :    79585995 :       c = next_char ();
     698                 :             :     }
     699                 :    79585995 :   while (c != '\n');
     700                 :             : 
     701                 :     1347992 :   gfc_advance_line ();
     702                 :     1347992 : }
     703                 :             : 
     704                 :             : 
     705                 :             : bool
     706                 :     4637160 : gfc_define_undef_line (void)
     707                 :             : {
     708                 :     4637160 :   char *tmp;
     709                 :             : 
     710                 :             :   /* All lines beginning with '#' are either #define or #undef.  */
     711                 :     4637160 :   if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
     712                 :     4637152 :     return 0;
     713                 :             : 
     714                 :           8 :   if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
     715                 :             :     {
     716                 :           5 :       tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
     717                 :           5 :       (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.u.lb),
     718                 :             :                               tmp);
     719                 :           5 :       free (tmp);
     720                 :             :     }
     721                 :             : 
     722                 :           8 :   if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
     723                 :             :     {
     724                 :           3 :       tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
     725                 :           3 :       (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.u.lb),
     726                 :             :                              tmp);
     727                 :           3 :       free (tmp);
     728                 :             :     }
     729                 :             : 
     730                 :             :   /* Skip the rest of the line.  */
     731                 :           8 :   skip_comment_line ();
     732                 :             : 
     733                 :           8 :   return 1;
     734                 :             : }
     735                 :             : 
     736                 :             : 
     737                 :             : /* Return true if GCC$ was matched.  */
     738                 :             : static bool
     739                 :     4946583 : skip_gcc_attribute (locus start)
     740                 :             : {
     741                 :     4946583 :   bool r = false;
     742                 :     4946583 :   char c;
     743                 :     4946583 :   locus old_loc = gfc_current_locus;
     744                 :             : 
     745                 :     4946583 :   if ((c = next_char ()) == 'g' || c == 'G')
     746                 :     3516642 :     if ((c = next_char ()) == 'c' || c == 'C')
     747                 :     3514582 :       if ((c = next_char ()) == 'c' || c == 'C')
     748                 :     3514582 :         if ((c = next_char ()) == '$')
     749                 :     3514582 :           r = true;
     750                 :             : 
     751                 :     3514582 :   if (r == false)
     752                 :     1432001 :     gfc_current_locus = old_loc;
     753                 :             :   else
     754                 :             :    {
     755                 :     3514582 :       gcc_attribute_flag = 1;
     756                 :     3514582 :       gcc_attribute_locus = old_loc;
     757                 :     3514582 :       gfc_current_locus = start;
     758                 :             :    }
     759                 :             : 
     760                 :     4946583 :   return r;
     761                 :             : }
     762                 :             : 
     763                 :             : /* Return true if CC was matched.  */
     764                 :             : static bool
     765                 :       20202 : skip_free_oacc_sentinel (locus start, locus old_loc)
     766                 :             : {
     767                 :       20202 :   bool r = false;
     768                 :       20202 :   char c;
     769                 :             : 
     770                 :       20202 :   if ((c = next_char ()) == 'c' || c == 'C')
     771                 :       20202 :     if ((c = next_char ()) == 'c' || c == 'C')
     772                 :       20202 :       r = true;
     773                 :             : 
     774                 :       20202 :   if (r)
     775                 :             :    {
     776                 :       20214 :       if ((c = next_char ()) == ' ' || c == '\t'
     777                 :       20214 :           || continue_flag)
     778                 :             :         {
     779                 :       40577 :           while (gfc_is_whitespace (c))
     780                 :       20376 :             c = next_char ();
     781                 :       20201 :           if (c != '\n' && c != '!')
     782                 :             :             {
     783                 :       20200 :               openacc_flag = 1;
     784                 :       20200 :               openacc_locus = old_loc;
     785                 :       20200 :               gfc_current_locus = start;
     786                 :             :             }
     787                 :             :           else
     788                 :             :             r = false;
     789                 :             :         }
     790                 :             :       else
     791                 :             :         {
     792                 :           1 :           gfc_warning_now (0, "!$ACC at %C starts a commented "
     793                 :             :                            "line as it neither is followed "
     794                 :             :                            "by a space nor is a "
     795                 :             :                            "continuation line");
     796                 :           1 :           r = false;
     797                 :             :         }
     798                 :             :    }
     799                 :             : 
     800                 :       20202 :   return r;
     801                 :             : }
     802                 :             : 
     803                 :             : /* Return true if MP was matched.  */
     804                 :             : static bool
     805                 :       37459 : skip_free_omp_sentinel (locus start, locus old_loc)
     806                 :             : {
     807                 :       37459 :   bool r = false;
     808                 :       37459 :   char c;
     809                 :             : 
     810                 :       37459 :   if ((c = next_char ()) == 'm' || c == 'M')
     811                 :       37458 :     if ((c = next_char ()) == 'p' || c == 'P')
     812                 :       37458 :       r = true;
     813                 :             : 
     814                 :       37458 :   if (r)
     815                 :             :    {
     816                 :       39463 :       if ((c = next_char ()) == ' ' || c == '\t'
     817                 :       39462 :           || continue_flag)
     818                 :             :         {
     819                 :       74078 :           while (gfc_is_whitespace (c))
     820                 :       36624 :             c = next_char ();
     821                 :       37454 :           if (c != '\n' && c != '!')
     822                 :             :             {
     823                 :       37454 :               openmp_flag = 1;
     824                 :       37454 :               openmp_locus = old_loc;
     825                 :       37454 :               gfc_current_locus = start;
     826                 :             :             }
     827                 :             :           else
     828                 :             :             r = false;
     829                 :             :         }
     830                 :             :       else
     831                 :             :         {
     832                 :           4 :           gfc_warning_now (0, "!$OMP at %C starts a commented "
     833                 :             :                            "line as it neither is followed "
     834                 :             :                            "by a space nor is a "
     835                 :             :                            "continuation line");
     836                 :           4 :           r = false;
     837                 :             :         }
     838                 :             :    }
     839                 :             : 
     840                 :       37459 :   return r;
     841                 :             : }
     842                 :             : 
     843                 :             : /* Comment lines are null lines, lines containing only blanks or lines
     844                 :             :    on which the first nonblank line is a '!'.
     845                 :             :    Return true if !$ openmp or openacc conditional compilation sentinel was
     846                 :             :    seen.  */
     847                 :             : 
     848                 :             : static bool
     849                 :     4647857 : skip_free_comments (void)
     850                 :             : {
     851                 :     6463185 :   locus start;
     852                 :     6463185 :   gfc_char_t c;
     853                 :     6463185 :   int at_bol;
     854                 :             : 
     855                 :     6463185 :   for (;;)
     856                 :             :     {
     857                 :     6463185 :       at_bol = gfc_at_bol ();
     858                 :     6463185 :       start = gfc_current_locus;
     859                 :     6463185 :       if (gfc_at_eof ())
     860                 :             :         break;
     861                 :             : 
     862                 :    13896239 :       do
     863                 :    13896239 :         c = next_char ();
     864                 :    13896239 :       while (gfc_is_whitespace (c));
     865                 :             : 
     866                 :     6434517 :       if (c == '\n')
     867                 :             :         {
     868                 :     1130581 :           gfc_advance_line ();
     869                 :     1130581 :           continue;
     870                 :             :         }
     871                 :             : 
     872                 :     5303936 :       if (c == '!')
     873                 :             :         {
     874                 :             :           /* Keep the !GCC$ line.  */
     875                 :     3838397 :           if (at_bol && skip_gcc_attribute (start))
     876                 :             :             return false;
     877                 :             : 
     878                 :             :           /* If -fopenmp/-fopenacc, we need to handle here 2 things:
     879                 :             :              1) don't treat !$omp/!$acc as comments, but directives
     880                 :             :              2) handle OpenMP conditional compilation, where
     881                 :             :                 !$ should be treated as 2 spaces (for initial lines
     882                 :             :                 only if followed by space).  */
     883                 :      742928 :           if (at_bol)
     884                 :             :           {
     885                 :      742866 :             if ((flag_openmp || flag_openmp_simd)
     886                 :      102588 :                 && flag_openacc)
     887                 :             :               {
     888                 :         605 :                 locus old_loc = gfc_current_locus;
     889                 :         605 :                 if (next_char () == '$')
     890                 :             :                   {
     891                 :         409 :                     c = next_char ();
     892                 :         409 :                     if (c == 'o' || c == 'O')
     893                 :             :                       {
     894                 :         105 :                         if (skip_free_omp_sentinel (start, old_loc))
     895                 :         405 :                           return false;
     896                 :           0 :                         gfc_current_locus = old_loc;
     897                 :           0 :                         next_char ();
     898                 :           0 :                         c = next_char ();
     899                 :             :                       }
     900                 :         304 :                     else if (c == 'a' || c == 'A')
     901                 :             :                       {
     902                 :         184 :                         if (skip_free_oacc_sentinel (start, old_loc))
     903                 :             :                           return false;
     904                 :           0 :                         gfc_current_locus = old_loc;
     905                 :           0 :                         next_char ();
     906                 :           0 :                         c = next_char ();
     907                 :             :                       }
     908                 :         120 :                     if (continue_flag || c == ' ' || c == '\t')
     909                 :             :                       {
     910                 :         116 :                         gfc_current_locus = old_loc;
     911                 :         116 :                         next_char ();
     912                 :         116 :                         openmp_flag = openacc_flag = 0;
     913                 :         116 :                         return true;
     914                 :             :                       }
     915                 :             :                   }
     916                 :         200 :                 gfc_current_locus = old_loc;
     917                 :         200 :               }
     918                 :      742261 :             else if ((flag_openmp || flag_openmp_simd)
     919                 :      101983 :                      && !flag_openacc)
     920                 :             :               {
     921                 :      101983 :                 locus old_loc = gfc_current_locus;
     922                 :      101983 :                 if (next_char () == '$')
     923                 :             :                   {
     924                 :       37815 :                     c = next_char ();
     925                 :       37815 :                     if (c == 'o' || c == 'O')
     926                 :             :                       {
     927                 :       37354 :                         if (skip_free_omp_sentinel (start, old_loc))
     928                 :       37760 :                           return false;
     929                 :           5 :                         gfc_current_locus = old_loc;
     930                 :           5 :                         next_char ();
     931                 :           5 :                         c = next_char ();
     932                 :             :                       }
     933                 :         466 :                     if (continue_flag || c == ' ' || c == '\t')
     934                 :             :                       {
     935                 :         411 :                         gfc_current_locus = old_loc;
     936                 :         411 :                         next_char ();
     937                 :         411 :                         openmp_flag = 0;
     938                 :         411 :                         return true;
     939                 :             :                       }
     940                 :             :                   }
     941                 :       64223 :                 gfc_current_locus = old_loc;
     942                 :       64223 :               }
     943                 :      640278 :             else if (flag_openacc
     944                 :       56917 :                      && !(flag_openmp || flag_openmp_simd))
     945                 :             :               {
     946                 :       56917 :                 locus old_loc = gfc_current_locus;
     947                 :       56917 :                 if (next_char () == '$')
     948                 :             :                   {
     949                 :       20047 :                     c = next_char ();
     950                 :       20047 :                     if (c == 'a' || c == 'A')
     951                 :             :                       {
     952                 :       20018 :                         if (skip_free_oacc_sentinel (start, old_loc))
     953                 :       20016 :                           return false;
     954                 :           2 :                         gfc_current_locus = old_loc;
     955                 :           2 :                         next_char();
     956                 :           2 :                         c = next_char();
     957                 :             :                       }
     958                 :             :                   }
     959                 :       36901 :                 gfc_current_locus = old_loc;
     960                 :             :               }
     961                 :             :           }
     962                 :      684747 :           skip_comment_line ();
     963                 :      684747 :           continue;
     964                 :      684747 :         }
     965                 :             : 
     966                 :             :       break;
     967                 :             :     }
     968                 :             : 
     969                 :     1494207 :   if (openmp_flag && at_bol)
     970                 :       22046 :     openmp_flag = 0;
     971                 :             : 
     972                 :     1494207 :   if (openacc_flag && at_bol)
     973                 :       11902 :     openacc_flag = 0;
     974                 :             : 
     975                 :     1494207 :   gcc_attribute_flag = 0;
     976                 :     1494207 :   gfc_current_locus = start;
     977                 :     1494207 :   return false;
     978                 :             : }
     979                 :             : 
     980                 :             : /* Return true if MP was matched in fixed form.  */
     981                 :             : static bool
     982                 :        9653 : skip_fixed_omp_sentinel (locus *start)
     983                 :             : {
     984                 :        9653 :   gfc_char_t c;
     985                 :        9653 :   if ((c = next_char ()) != 'm' && c != 'M')
     986                 :             :     return false;
     987                 :        9653 :   if ((c = next_char ()) == 'p' || c == 'P')
     988                 :             :     {
     989                 :        9629 :       c = next_char ();
     990                 :        9629 :       if (c != '\n'
     991                 :        9629 :           && (continue_flag
     992                 :         275 :               || c == ' ' || c == '\t' || c == '0'))
     993                 :             :         {
     994                 :        9628 :           if (c == ' ' || c == '\t' || c == '0')
     995                 :        9565 :             openacc_flag = 0;
     996                 :        9720 :           do
     997                 :        9720 :             c = next_char ();
     998                 :        9720 :           while (gfc_is_whitespace (c));
     999                 :        9628 :           if (c != '\n' && c != '!')
    1000                 :             :             {
    1001                 :             :               /* Canonicalize to *$omp.  */
    1002                 :        9628 :               *start->nextc = '*';
    1003                 :        9628 :               openmp_flag = 1;
    1004                 :        9628 :               gfc_current_locus = *start;
    1005                 :        9628 :               return true;
    1006                 :             :             }
    1007                 :             :         }
    1008                 :             :     }
    1009                 :          24 :   else if (UNLIKELY (c == 'x' || c == 'X'))
    1010                 :          24 :     gfc_warning_now (OPT_Wsurprising,
    1011                 :             :                      "Ignoring %<!$omx%> vendor-extension sentinel at %C");
    1012                 :             :   return false;
    1013                 :             : }
    1014                 :             : 
    1015                 :             : /* Return true if CC was matched in fixed form.  */
    1016                 :             : static bool
    1017                 :       40169 : skip_fixed_oacc_sentinel (locus *start)
    1018                 :             : {
    1019                 :       40169 :   gfc_char_t c;
    1020                 :       67392 :   if (((c = next_char ()) == 'c' || c == 'C')
    1021                 :       67378 :       && ((c = next_char ()) == 'c' || c == 'C'))
    1022                 :             :     {
    1023                 :       40155 :       c = next_char ();
    1024                 :       40155 :       if (c != '\n'
    1025                 :       40155 :           && (continue_flag
    1026                 :        1052 :               || c == ' ' || c == '\t' || c == '0'))
    1027                 :             :         {
    1028                 :       40152 :           if (c == ' ' || c == '\t' || c == '0')
    1029                 :       40023 :             openmp_flag = 0;
    1030                 :       40281 :           do
    1031                 :       40281 :             c = next_char ();
    1032                 :       40281 :           while (gfc_is_whitespace (c));
    1033                 :       40152 :           if (c != '\n' && c != '!')
    1034                 :             :             {
    1035                 :             :               /* Canonicalize to *$acc.  */
    1036                 :       40152 :               *start->nextc = '*';
    1037                 :       40152 :               openacc_flag = 1;
    1038                 :       40152 :               gfc_current_locus = *start;
    1039                 :       40152 :               return true;
    1040                 :             :             }
    1041                 :             :         }
    1042                 :             :     }
    1043                 :             :   return false;
    1044                 :             : }
    1045                 :             : 
    1046                 :             : /* Skip comment lines in fixed source mode.  We have the same rules as
    1047                 :             :    in skip_free_comment(), except that we can have a 'c', 'C' or '*'
    1048                 :             :    in column 1, and a '!' cannot be in column 6.  Also, we deal with
    1049                 :             :    lines with 'd' or 'D' in column 1, if the user requested this.  */
    1050                 :             : 
    1051                 :             : static void
    1052                 :     3351005 : skip_fixed_comments (void)
    1053                 :             : {
    1054                 :     3351005 :   locus start;
    1055                 :     3351005 :   int col;
    1056                 :     3351005 :   gfc_char_t c;
    1057                 :             : 
    1058                 :     3351005 :   if (! gfc_at_bol ())
    1059                 :             :     {
    1060                 :          48 :       start = gfc_current_locus;
    1061                 :          48 :       if (! gfc_at_eof ())
    1062                 :             :         {
    1063                 :         136 :           do
    1064                 :         136 :             c = next_char ();
    1065                 :         136 :           while (gfc_is_whitespace (c));
    1066                 :             : 
    1067                 :          48 :           if (c == '\n')
    1068                 :           2 :             gfc_advance_line ();
    1069                 :          46 :           else if (c == '!')
    1070                 :           1 :             skip_comment_line ();
    1071                 :             :         }
    1072                 :             : 
    1073                 :          48 :       if (! gfc_at_bol ())
    1074                 :             :         {
    1075                 :          45 :           gfc_current_locus = start;
    1076                 :      468938 :           return;
    1077                 :             :         }
    1078                 :             :     }
    1079                 :             : 
    1080                 :     4597855 :   for (;;)
    1081                 :             :     {
    1082                 :     4597855 :       start = gfc_current_locus;
    1083                 :     4597855 :       if (gfc_at_eof ())
    1084                 :             :         break;
    1085                 :             : 
    1086                 :     4475859 :       c = next_char ();
    1087                 :     4475859 :       if (c == '\n')
    1088                 :             :         {
    1089                 :        4761 :           gfc_advance_line ();
    1090                 :        4761 :           continue;
    1091                 :             :         }
    1092                 :             : 
    1093                 :             :       if (c == '!' || c == 'c' || c == 'C' || c == '*')
    1094                 :             :         {
    1095                 :     1108248 :           if (skip_gcc_attribute (start))
    1096                 :             :             {
    1097                 :             :               /* Canonicalize to *$omp.  */
    1098                 :      419113 :               *start.nextc = '*';
    1099                 :      419113 :               return;
    1100                 :             :             }
    1101                 :             : 
    1102                 :      689135 :           if (gfc_current_locus.u.lb != NULL
    1103                 :      689135 :               && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
    1104                 :      530885 :             continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
    1105                 :             : 
    1106                 :             :           /* If -fopenmp/-fopenacc, we need to handle here 2 things:
    1107                 :             :              1) don't treat !$omp/!$acc|c$omp/c$acc|*$omp / *$acc as comments,
    1108                 :             :                 but directives
    1109                 :             :              2) handle OpenMP conditional compilation, where
    1110                 :             :                 !$|c$|*$ should be treated as 2 spaces if the characters
    1111                 :             :                 in columns 3 to 6 are valid fixed form label columns
    1112                 :             :                 characters.  */
    1113                 :      689135 :           if ((flag_openmp || flag_openmp_simd) && !flag_openacc)
    1114                 :             :             {
    1115                 :       66169 :               if (next_char () == '$')
    1116                 :             :                 {
    1117                 :        9359 :                   c = next_char ();
    1118                 :        9359 :                   if (c == 'o' || c == 'O')
    1119                 :             :                     {
    1120                 :        9227 :                       if (skip_fixed_omp_sentinel (&start))
    1121                 :             :                         return;
    1122                 :             :                     }
    1123                 :             :                   else
    1124                 :         132 :                     goto check_for_digits;
    1125                 :             :                 }
    1126                 :       56834 :               gfc_current_locus = start;
    1127                 :             :             }
    1128                 :      622966 :           else if (flag_openacc && !(flag_openmp || flag_openmp_simd))
    1129                 :             :             {
    1130                 :      148376 :               if (next_char () == '$')
    1131                 :             :                 {
    1132                 :       39993 :                   c = next_char ();
    1133                 :       39993 :                   if (c == 'a' || c == 'A')
    1134                 :             :                     {
    1135                 :       39877 :                       if (skip_fixed_oacc_sentinel (&start))
    1136                 :             :                         return;
    1137                 :             :                     }
    1138                 :             :                 }
    1139                 :      108501 :               gfc_current_locus = start;
    1140                 :             :             }
    1141                 :      474590 :           else if (flag_openacc || flag_openmp || flag_openmp_simd)
    1142                 :             :             {
    1143                 :        2674 :               if (next_char () == '$')
    1144                 :             :                 {
    1145                 :        1280 :                   c = next_char ();
    1146                 :        1280 :                   if (c == 'a' || c == 'A')
    1147                 :             :                     {
    1148                 :         292 :                       if (skip_fixed_oacc_sentinel (&start))
    1149                 :             :                         return;
    1150                 :             :                     }
    1151                 :         988 :                   else if (c == 'o' || c == 'O')
    1152                 :             :                     {
    1153                 :         426 :                       if (skip_fixed_omp_sentinel (&start))
    1154                 :             :                         return;
    1155                 :             :                     }
    1156                 :             :                   else
    1157                 :         562 :                     goto check_for_digits;
    1158                 :             :                 }
    1159                 :        1410 :               gfc_current_locus = start;
    1160                 :             :             }
    1161                 :             : 
    1162                 :      638661 :           skip_comment_line ();
    1163                 :      638661 :           continue;
    1164                 :             : 
    1165                 :             : check_for_digits:
    1166                 :             :           {
    1167                 :             :             /* Required for OpenMP's conditional compilation sentinel. */
    1168                 :             :             int digit_seen = 0;
    1169                 :             : 
    1170                 :        1382 :             for (col = 3; col < 6; col++, c = next_char ())
    1171                 :        1300 :               if (c == ' ')
    1172                 :         578 :                 continue;
    1173                 :         722 :               else if (c == '\t')
    1174                 :             :                 {
    1175                 :             :                   col = 6;
    1176                 :             :                   break;
    1177                 :             :                 }
    1178                 :         722 :               else if (c < '0' || c > '9')
    1179                 :             :                 break;
    1180                 :             :               else
    1181                 :             :                 digit_seen = 1;
    1182                 :             : 
    1183                 :         694 :             if (col == 6 && c != '\n'
    1184                 :          82 :                 && ((continue_flag && !digit_seen)
    1185                 :          47 :                     || c == ' ' || c == '\t' || c == '0'))
    1186                 :             :               {
    1187                 :          45 :                 gfc_current_locus = start;
    1188                 :          45 :                 start.nextc[0] = ' ';
    1189                 :          45 :                 start.nextc[1] = ' ';
    1190                 :          45 :                 continue;
    1191                 :             :               }
    1192                 :             :             }
    1193                 :         649 :           skip_comment_line ();
    1194                 :         649 :           continue;
    1195                 :      639310 :         }
    1196                 :             : 
    1197                 :     3362850 :       if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
    1198                 :             :         {
    1199                 :          16 :           if (gfc_option.flag_d_lines == 0)
    1200                 :             :             {
    1201                 :           8 :               skip_comment_line ();
    1202                 :           8 :               continue;
    1203                 :             :             }
    1204                 :             :           else
    1205                 :           8 :             *start.nextc = c = ' ';
    1206                 :             :         }
    1207                 :             : 
    1208                 :             :       col = 1;
    1209                 :             : 
    1210                 :    65877645 :       while (gfc_is_whitespace (c))
    1211                 :             :         {
    1212                 :    62514803 :           c = next_char ();
    1213                 :    62514803 :           col++;
    1214                 :             :         }
    1215                 :             : 
    1216                 :     3362842 :       if (c == '\n')
    1217                 :             :         {
    1218                 :      592621 :           gfc_advance_line ();
    1219                 :      592621 :           continue;
    1220                 :             :         }
    1221                 :             : 
    1222                 :     2770221 :       if (col != 6 && c == '!')
    1223                 :             :         {
    1224                 :       10150 :           if (gfc_current_locus.u.lb != NULL
    1225                 :       10150 :               && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
    1226                 :        5355 :             continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
    1227                 :       10150 :           skip_comment_line ();
    1228                 :       10150 :           continue;
    1229                 :             :         }
    1230                 :             : 
    1231                 :             :       break;
    1232                 :             :     }
    1233                 :             : 
    1234                 :     2882067 :   openmp_flag = 0;
    1235                 :     2882067 :   openacc_flag = 0;
    1236                 :     2882067 :   gcc_attribute_flag = 0;
    1237                 :     2882067 :   gfc_current_locus = start;
    1238                 :             : }
    1239                 :             : 
    1240                 :             : 
    1241                 :             : /* Skips the current line if it is a comment.  */
    1242                 :             : 
    1243                 :             : void
    1244                 :     4667683 : gfc_skip_comments (void)
    1245                 :             : {
    1246                 :     4667683 :   if (gfc_current_form == FORM_FREE)
    1247                 :     4393714 :     skip_free_comments ();
    1248                 :             :   else
    1249                 :      273969 :     skip_fixed_comments ();
    1250                 :     4667683 : }
    1251                 :             : 
    1252                 :             : 
    1253                 :             : /* Get the next character from the input, taking continuation lines
    1254                 :             :    and end-of-line comments into account.  This implies that comment
    1255                 :             :    lines between continued lines must be eaten here.  For higher-level
    1256                 :             :    subroutines, this flattens continued lines into a single logical
    1257                 :             :    line.  The in_string flag denotes whether we're inside a character
    1258                 :             :    context or not.  */
    1259                 :             : 
    1260                 :             : gfc_char_t
    1261                 :  1101790422 : gfc_next_char_literal (gfc_instring in_string)
    1262                 :             : {
    1263                 :  1101790422 :   static locus omp_acc_err_loc = {};
    1264                 :  1101790422 :   locus old_loc;
    1265                 :  1101790422 :   int i, prev_openmp_flag, prev_openacc_flag;
    1266                 :  1101790422 :   gfc_char_t c;
    1267                 :             : 
    1268                 :  1101790422 :   continue_flag = 0;
    1269                 :  1101790422 :   prev_openacc_flag = prev_openmp_flag = 0;
    1270                 :             : 
    1271                 :  1101854458 : restart:
    1272                 :  1101854458 :   c = next_char ();
    1273                 :  1101854458 :   if (gfc_at_end ())
    1274                 :             :     {
    1275                 :         161 :       continue_count = 0;
    1276                 :         161 :       return c;
    1277                 :             :     }
    1278                 :             : 
    1279                 :  1101854297 :   if (gfc_current_form == FORM_FREE)
    1280                 :             :     {
    1281                 :   988871701 :       bool openmp_cond_flag;
    1282                 :             : 
    1283                 :   988871701 :       if (!in_string && c == '!')
    1284                 :             :         {
    1285                 :    10046872 :           if (gcc_attribute_flag
    1286                 :     9287328 :               && memcmp (&gfc_current_locus, &gcc_attribute_locus,
    1287                 :             :                  sizeof (gfc_current_locus)) == 0)
    1288                 :     9286839 :             goto done;
    1289                 :             : 
    1290                 :      760033 :           if (openmp_flag
    1291                 :      109155 :               && memcmp (&gfc_current_locus, &openmp_locus,
    1292                 :             :                  sizeof (gfc_current_locus)) == 0)
    1293                 :       95265 :             goto done;
    1294                 :             : 
    1295                 :      664768 :           if (openacc_flag
    1296                 :       77275 :               && memcmp (&gfc_current_locus, &openacc_locus,
    1297                 :             :                  sizeof (gfc_current_locus)) == 0)
    1298                 :       59193 :             goto done;
    1299                 :             : 
    1300                 :             :           /* This line can't be continued */
    1301                 :    21590869 :           do
    1302                 :             :             {
    1303                 :    21590869 :               c = next_char ();
    1304                 :             :             }
    1305                 :    21590869 :           while (c != '\n');
    1306                 :             : 
    1307                 :             :           /* Avoid truncation warnings for comment ending lines.  */
    1308                 :      605575 :           gfc_current_locus.u.lb->truncated = 0;
    1309                 :             : 
    1310                 :      605575 :           goto done;
    1311                 :             :         }
    1312                 :             : 
    1313                 :             :       /* Check to see if the continuation line was truncated.  */
    1314                 :   978824829 :       if (warn_line_truncation && gfc_current_locus.u.lb != NULL
    1315                 :   978733717 :           && gfc_current_locus.u.lb->truncated)
    1316                 :             :         {
    1317                 :          14 :           int maxlen = flag_free_line_length;
    1318                 :          14 :           gfc_char_t *current_nextc = gfc_current_locus.nextc;
    1319                 :             : 
    1320                 :          14 :           gfc_current_locus.u.lb->truncated = 0;
    1321                 :          14 :           gfc_current_locus.nextc =  gfc_current_locus.u.lb->line + maxlen;
    1322                 :          14 :           gfc_warning_now (OPT_Wline_truncation,
    1323                 :             :                            "Line truncated at %L", &gfc_current_locus);
    1324                 :          14 :           gfc_current_locus.nextc = current_nextc;
    1325                 :             :         }
    1326                 :             : 
    1327                 :   978824829 :       if (c != '&')
    1328                 :   978566436 :         goto done;
    1329                 :             : 
    1330                 :             :       /* If the next nonblank character is a ! or \n, we've got a
    1331                 :             :          continuation line.  */
    1332                 :      258393 :       old_loc = gfc_current_locus;
    1333                 :             : 
    1334                 :      258393 :       c = next_char ();
    1335                 :      538312 :       while (gfc_is_whitespace (c))
    1336                 :       21526 :         c = next_char ();
    1337                 :             : 
    1338                 :             :       /* Character constants to be continued cannot have commentary
    1339                 :             :          after the '&'. However, there are cases where we may think we
    1340                 :             :          are still in a string and we are looking for a possible
    1341                 :             :          doubled quote and we end up here. See PR64506.  */
    1342                 :             : 
    1343                 :      258393 :       if (in_string && c != '\n')
    1344                 :             :         {
    1345                 :        4042 :           gfc_current_locus = old_loc;
    1346                 :        4042 :           c = '&';
    1347                 :        4042 :           goto done;
    1348                 :             :         }
    1349                 :             : 
    1350                 :      254351 :       if (c != '!' && c != '\n')
    1351                 :             :         {
    1352                 :         185 :           gfc_current_locus = old_loc;
    1353                 :         185 :           c = '&';
    1354                 :         185 :           goto done;
    1355                 :             :         }
    1356                 :             : 
    1357                 :      254166 :       if (flag_openmp)
    1358                 :       24897 :         prev_openmp_flag = openmp_flag;
    1359                 :      254166 :       if (flag_openacc)
    1360                 :        4760 :         prev_openacc_flag = openacc_flag;
    1361                 :             : 
    1362                 :             :       /* This can happen if the input file changed or via cpp's #line
    1363                 :             :          without getting reset (e.g. via input_stmt). It also happens
    1364                 :             :          when pre-including files via -fpre-include=.  */
    1365                 :      254166 :       if (continue_count == 0
    1366                 :      112280 :           && gfc_current_locus.u.lb
    1367                 :      366446 :           && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1)
    1368                 :        3849 :         continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1;
    1369                 :             : 
    1370                 :      254166 :       continue_flag = 1;
    1371                 :      254166 :       if (c == '!')
    1372                 :       13768 :         skip_comment_line ();
    1373                 :             :       else
    1374                 :      240398 :         gfc_advance_line ();
    1375                 :             : 
    1376                 :      254166 :       if (gfc_at_eof ())
    1377                 :          23 :         goto not_continuation;
    1378                 :             : 
    1379                 :             :       /* We've got a continuation line.  If we are on the very next line after
    1380                 :             :          the last continuation, increment the continuation line count and
    1381                 :             :          check whether the limit has been exceeded.  */
    1382                 :      254143 :       if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1)
    1383                 :             :         {
    1384                 :       20500 :           if (++continue_count == gfc_option.max_continue_free)
    1385                 :             :             {
    1386                 :           4 :               if (gfc_notification_std (GFC_STD_GNU) || pedantic)
    1387                 :           4 :                 gfc_warning (0, "Limit of %d continuations exceeded in "
    1388                 :             :                              "statement at %C", gfc_option.max_continue_free);
    1389                 :             :             }
    1390                 :             :         }
    1391                 :             : 
    1392                 :             :       /* Now find where it continues. First eat any comment lines.  */
    1393                 :      254143 :       openmp_cond_flag = skip_free_comments ();
    1394                 :             : 
    1395                 :      254143 :       if (gfc_current_locus.u.lb != NULL
    1396                 :      254143 :           && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
    1397                 :       35603 :         continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
    1398                 :             : 
    1399                 :      254143 :       if (flag_openmp)
    1400                 :       24892 :         if (prev_openmp_flag != openmp_flag && !openacc_flag)
    1401                 :             :           {
    1402                 :         276 :             gfc_current_locus = old_loc;
    1403                 :         276 :             openmp_flag = prev_openmp_flag;
    1404                 :         276 :             c = '&';
    1405                 :         276 :             goto done;
    1406                 :             :           }
    1407                 :             : 
    1408                 :      253867 :       if (flag_openacc)
    1409                 :        4760 :         if (prev_openacc_flag != openacc_flag && !openmp_flag)
    1410                 :             :           {
    1411                 :           5 :             gfc_current_locus = old_loc;
    1412                 :           5 :             openacc_flag = prev_openacc_flag;
    1413                 :           5 :             c = '&';
    1414                 :           5 :             goto done;
    1415                 :             :           }
    1416                 :             : 
    1417                 :             :       /* Now that we have a non-comment line, probe ahead for the
    1418                 :             :          first non-whitespace character.  If it is another '&', then
    1419                 :             :          reading starts at the next character, otherwise we must back
    1420                 :             :          up to where the whitespace started and resume from there.  */
    1421                 :             : 
    1422                 :      253862 :       old_loc = gfc_current_locus;
    1423                 :             : 
    1424                 :      253862 :       c = next_char ();
    1425                 :     3869019 :       while (gfc_is_whitespace (c))
    1426                 :     3361295 :         c = next_char ();
    1427                 :             : 
    1428                 :      253862 :       if (openmp_flag && !openacc_flag)
    1429                 :             :         {
    1430                 :       33162 :           for (i = 0; i < 5; i++, c = next_char ())
    1431                 :             :             {
    1432                 :       27635 :               gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
    1433                 :       27635 :               if (i == 4)
    1434                 :        5527 :                 old_loc = gfc_current_locus;
    1435                 :             :             }
    1436                 :       10204 :           while (gfc_is_whitespace (c))
    1437                 :        4677 :             c = next_char ();
    1438                 :             :         }
    1439                 :      253862 :       if (openacc_flag && !openmp_flag)
    1440                 :             :         {
    1441                 :        2490 :           for (i = 0; i < 5; i++, c = next_char ())
    1442                 :             :             {
    1443                 :        2075 :               gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$acc"[i]);
    1444                 :        2075 :               if (i == 4)
    1445                 :         415 :                 old_loc = gfc_current_locus;
    1446                 :             :             }
    1447                 :        1002 :           while (gfc_is_whitespace (c))
    1448                 :         587 :             c = next_char ();
    1449                 :             :         }
    1450                 :             : 
    1451                 :             :       /* In case we have an OpenMP directive continued by OpenACC
    1452                 :             :          sentinel, or vice versa, we get both openmp_flag and
    1453                 :             :          openacc_flag on.  */
    1454                 :             : 
    1455                 :      253862 :       if (openacc_flag && openmp_flag)
    1456                 :             :         {
    1457                 :             :           int is_openmp = 0;
    1458                 :         372 :           for (i = 0; i < 5; i++, c = next_char ())
    1459                 :             :             {
    1460                 :         310 :               if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i])
    1461                 :          24 :                 is_openmp = 1;
    1462                 :             :             }
    1463                 :          62 :           if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
    1464                 :          59 :               || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb)
    1465                 :           5 :             gfc_error_now (is_openmp
    1466                 :             :                            ? G_("Wrong OpenACC continuation at %C: "
    1467                 :             :                                 "expected !$ACC, got !$OMP")
    1468                 :             :                            : G_("Wrong OpenMP continuation at %C: "
    1469                 :             :                                 "expected !$OMP, got !$ACC"));
    1470                 :          62 :           omp_acc_err_loc = gfc_current_locus;
    1471                 :          62 :           goto not_continuation;
    1472                 :             :         }
    1473                 :             : 
    1474                 :      253800 :       if (c != '&')
    1475                 :             :         {
    1476                 :      236229 :           if (in_string && gfc_current_locus.nextc)
    1477                 :             :             {
    1478                 :          44 :               gfc_current_locus.nextc--;
    1479                 :          44 :               if (warn_ampersand && in_string == INSTRING_WARN)
    1480                 :          14 :                 gfc_warning (OPT_Wampersand,
    1481                 :             :                              "Missing %<&%> in continued character "
    1482                 :             :                              "constant at %C");
    1483                 :             :             }
    1484                 :      236184 :           else if (!in_string && (c == '\'' || c == '"'))
    1485                 :       86181 :               goto done;
    1486                 :             :           /* Both !$omp and !$ -fopenmp continuation lines have & on the
    1487                 :             :              continuation line only optionally.  */
    1488                 :      150004 :           else if (openmp_flag || openacc_flag || openmp_cond_flag)
    1489                 :             :             {
    1490                 :        2156 :               if (gfc_current_locus.nextc)
    1491                 :        2156 :                   gfc_current_locus.nextc--;
    1492                 :             :             }
    1493                 :             :           else
    1494                 :             :             {
    1495                 :      147848 :               c = ' ';
    1496                 :      147848 :               gfc_current_locus = old_loc;
    1497                 :      147848 :               goto done;
    1498                 :             :             }
    1499                 :             :         }
    1500                 :             :     }
    1501                 :             :   else /* Fixed form.  */
    1502                 :             :     {
    1503                 :             :       /* Fixed form continuation.  */
    1504                 :   112982596 :       if (in_string != INSTRING_WARN && c == '!')
    1505                 :             :         {
    1506                 :             :           /* Skip comment at end of line.  */
    1507                 :     1631417 :           do
    1508                 :             :             {
    1509                 :     1631417 :               c = next_char ();
    1510                 :             :             }
    1511                 :     1631417 :           while (c != '\n');
    1512                 :             : 
    1513                 :             :           /* Avoid truncation warnings for comment ending lines.  */
    1514                 :       37947 :           gfc_current_locus.u.lb->truncated = 0;
    1515                 :             :         }
    1516                 :             : 
    1517                 :   112982596 :       if (c != '\n')
    1518                 :   109905560 :         goto done;
    1519                 :             : 
    1520                 :             :       /* Check to see if the continuation line was truncated.  */
    1521                 :     3077036 :       if (warn_line_truncation && gfc_current_locus.u.lb != NULL
    1522                 :       16853 :           && gfc_current_locus.u.lb->truncated)
    1523                 :             :         {
    1524                 :           5 :           gfc_current_locus.u.lb->truncated = 0;
    1525                 :           5 :           gfc_warning_now (OPT_Wline_truncation,
    1526                 :             :                            "Line truncated at %L", &gfc_current_locus);
    1527                 :             :         }
    1528                 :             : 
    1529                 :     3077036 :       if (flag_openmp)
    1530                 :      432196 :         prev_openmp_flag = openmp_flag;
    1531                 :     3077036 :       if (flag_openacc)
    1532                 :      859845 :         prev_openacc_flag = openacc_flag;
    1533                 :             : 
    1534                 :             :       /* This can happen if the input file changed or via cpp's #line
    1535                 :             :          without getting reset (e.g. via input_stmt). It also happens
    1536                 :             :          when pre-including files via -fpre-include=.  */
    1537                 :     3077036 :       if (continue_count == 0
    1538                 :     3047330 :           && gfc_current_locus.u.lb
    1539                 :     6124366 :           && continue_line > gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1)
    1540                 :       86808 :         continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb) + 1;
    1541                 :             : 
    1542                 :     3077036 :       continue_flag = 1;
    1543                 :     3077036 :       old_loc = gfc_current_locus;
    1544                 :             : 
    1545                 :     3077036 :       gfc_advance_line ();
    1546                 :     3077036 :       skip_fixed_comments ();
    1547                 :             : 
    1548                 :             :       /* See if this line is a continuation line.  */
    1549                 :     3077036 :       if (flag_openmp && openmp_flag != prev_openmp_flag && !openacc_flag)
    1550                 :             :         {
    1551                 :       10719 :           openmp_flag = prev_openmp_flag;
    1552                 :       10719 :           goto not_continuation;
    1553                 :             :         }
    1554                 :     3066317 :       if (flag_openacc && openacc_flag != prev_openacc_flag && !openmp_flag)
    1555                 :             :         {
    1556                 :       41257 :           openacc_flag = prev_openacc_flag;
    1557                 :       41257 :           goto not_continuation;
    1558                 :             :         }
    1559                 :             : 
    1560                 :             :       /* In case we have an OpenMP directive continued by OpenACC
    1561                 :             :          sentinel, or vice versa, we get both openmp_flag and
    1562                 :             :          openacc_flag on.  */
    1563                 :     3025060 :       if (openacc_flag && openmp_flag)
    1564                 :             :         {
    1565                 :             :           int is_openmp = 0;
    1566                 :         516 :           for (i = 0; i < 5; i++)
    1567                 :             :             {
    1568                 :         430 :               c = next_char ();
    1569                 :         430 :               if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
    1570                 :          24 :                 is_openmp = 1;
    1571                 :             :             }
    1572                 :          86 :           if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
    1573                 :          82 :               || omp_acc_err_loc.u.lb != gfc_current_locus.u.lb)
    1574                 :           7 :             gfc_error_now (is_openmp
    1575                 :             :                            ? G_("Wrong OpenACC continuation at %C: "
    1576                 :             :                                 "expected !$ACC, got !$OMP")
    1577                 :             :                            : G_("Wrong OpenMP continuation at %C: "
    1578                 :             :                                 "expected !$OMP, got !$ACC"));
    1579                 :          86 :           omp_acc_err_loc = gfc_current_locus;
    1580                 :          86 :           goto not_continuation;
    1581                 :             :         }
    1582                 :     3024974 :       else if (!openmp_flag && !openacc_flag)
    1583                 :    16024352 :         for (i = 0; i < 5; i++)
    1584                 :             :           {
    1585                 :    13464466 :             c = next_char ();
    1586                 :    13464466 :             if (c != ' ')
    1587                 :      462854 :               goto not_continuation;
    1588                 :             :           }
    1589                 :        2234 :       else if (openmp_flag)
    1590                 :        4638 :         for (i = 0; i < 5; i++)
    1591                 :             :           {
    1592                 :        3865 :             c = next_char ();
    1593                 :        3865 :             if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
    1594                 :           0 :               goto not_continuation;
    1595                 :             :           }
    1596                 :        1461 :       else if (openacc_flag)
    1597                 :        8766 :         for (i = 0; i < 5; i++)
    1598                 :             :           {
    1599                 :        7305 :             c = next_char ();
    1600                 :        7305 :             if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
    1601                 :           0 :               goto not_continuation;
    1602                 :             :           }
    1603                 :             : 
    1604                 :     2562120 :       c = next_char ();
    1605                 :     2562120 :       if (c == '0' || c == ' ' || c == '\n')
    1606                 :     2517855 :         goto not_continuation;
    1607                 :             : 
    1608                 :             :       /* We've got a continuation line.  If we are on the very next line after
    1609                 :             :          the last continuation, increment the continuation line count and
    1610                 :             :          check whether the limit has been exceeded.  */
    1611                 :       44265 :       if (gfc_linebuf_linenum (gfc_current_locus.u.lb) == continue_line + 1)
    1612                 :             :         {
    1613                 :        4019 :           if (++continue_count == gfc_option.max_continue_fixed)
    1614                 :             :             {
    1615                 :           2 :               if (gfc_notification_std (GFC_STD_GNU) || pedantic)
    1616                 :           2 :                 gfc_warning (0, "Limit of %d continuations exceeded in "
    1617                 :             :                              "statement at %C",
    1618                 :             :                              gfc_option.max_continue_fixed);
    1619                 :             :             }
    1620                 :             :         }
    1621                 :             : 
    1622                 :       44265 :       if (gfc_current_locus.u.lb != NULL
    1623                 :       44265 :           && continue_line < gfc_linebuf_linenum (gfc_current_locus.u.lb))
    1624                 :        6424 :         continue_line = gfc_linebuf_linenum (gfc_current_locus.u.lb);
    1625                 :             :     }
    1626                 :             : 
    1627                 :             :   /* Ready to read first character of continuation line, which might
    1628                 :             :      be another continuation line!  */
    1629                 :       64036 :   goto restart;
    1630                 :             : 
    1631                 :     3032856 : not_continuation:
    1632                 :     3032856 :   c = '\n';
    1633                 :     3032856 :   gfc_current_locus = old_loc;
    1634                 :     3032856 :   end_flag = 0;
    1635                 :             : 
    1636                 :  1101790261 : done:
    1637                 :  1101790261 :   if (c == '\n')
    1638                 :    37316905 :     continue_count = 0;
    1639                 :  1101790261 :   continue_flag = 0;
    1640                 :  1101790261 :   return c;
    1641                 :             : }
    1642                 :             : 
    1643                 :             : 
    1644                 :             : /* Get the next character of input, folded to lowercase.  In fixed
    1645                 :             :    form mode, we also ignore spaces.  When matcher subroutines are
    1646                 :             :    parsing character literals, they have to call
    1647                 :             :    gfc_next_char_literal().  */
    1648                 :             : 
    1649                 :             : gfc_char_t
    1650                 :   642161074 : gfc_next_char (void)
    1651                 :             : {
    1652                 :   667661410 :   gfc_char_t c;
    1653                 :             : 
    1654                 :   667661410 :   do
    1655                 :             :     {
    1656                 :   667661410 :       c = gfc_next_char_literal (NONSTRING);
    1657                 :             :     }
    1658                 :   667661410 :   while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
    1659                 :             : 
    1660                 :   642161074 :   return gfc_wide_tolower (c);
    1661                 :             : }
    1662                 :             : 
    1663                 :             : char
    1664                 :   597002513 : gfc_next_ascii_char (void)
    1665                 :             : {
    1666                 :   597002513 :   gfc_char_t c = gfc_next_char ();
    1667                 :             : 
    1668                 :   597002513 :   return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
    1669                 :   597002513 :                                     : (unsigned char) UCHAR_MAX);
    1670                 :             : }
    1671                 :             : 
    1672                 :             : 
    1673                 :             : gfc_char_t
    1674                 :    34949937 : gfc_peek_char (void)
    1675                 :             : {
    1676                 :    34949937 :   locus old_loc;
    1677                 :    34949937 :   gfc_char_t c;
    1678                 :             : 
    1679                 :    34949937 :   old_loc = gfc_current_locus;
    1680                 :    34949937 :   c = gfc_next_char ();
    1681                 :    34949937 :   gfc_current_locus = old_loc;
    1682                 :             : 
    1683                 :    34949937 :   return c;
    1684                 :             : }
    1685                 :             : 
    1686                 :             : 
    1687                 :             : char
    1688                 :    34937859 : gfc_peek_ascii_char (void)
    1689                 :             : {
    1690                 :    34937859 :   gfc_char_t c = gfc_peek_char ();
    1691                 :             : 
    1692                 :    34937859 :   return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
    1693                 :    34937859 :                                     : (unsigned char) UCHAR_MAX);
    1694                 :             : }
    1695                 :             : 
    1696                 :             : 
    1697                 :             : /* Recover from an error.  We try to get past the current statement
    1698                 :             :    and get lined up for the next.  The next statement follows a '\n'
    1699                 :             :    or a ';'.  We also assume that we are not within a character
    1700                 :             :    constant, and deal with finding a '\'' or '"'.  */
    1701                 :             : 
    1702                 :             : void
    1703                 :        3253 : gfc_error_recovery (void)
    1704                 :             : {
    1705                 :        3253 :   gfc_char_t c, delim;
    1706                 :             : 
    1707                 :        3253 :   if (gfc_at_eof ())
    1708                 :             :     return;
    1709                 :             : 
    1710                 :       90038 :   for (;;)
    1711                 :             :     {
    1712                 :       90038 :       c = gfc_next_char ();
    1713                 :       90038 :       if (c == '\n' || c == ';')
    1714                 :             :         break;
    1715                 :             : 
    1716                 :       86793 :       if (c != '\'' && c != '"')
    1717                 :             :         {
    1718                 :       86380 :           if (gfc_at_eof ())
    1719                 :             :             break;
    1720                 :       86380 :           continue;
    1721                 :             :         }
    1722                 :             :       delim = c;
    1723                 :             : 
    1724                 :        2969 :       for (;;)
    1725                 :             :         {
    1726                 :        2969 :           c = next_char ();
    1727                 :             : 
    1728                 :        2969 :           if (c == delim)
    1729                 :             :             break;
    1730                 :        2563 :           if (c == '\n')
    1731                 :             :             return;
    1732                 :        2556 :           if (c == '\\')
    1733                 :             :             {
    1734                 :           8 :               c = next_char ();
    1735                 :           8 :               if (c == '\n')
    1736                 :             :                 return;
    1737                 :             :             }
    1738                 :             :         }
    1739                 :         406 :       if (gfc_at_eof ())
    1740                 :             :         break;
    1741                 :             :     }
    1742                 :             : }
    1743                 :             : 
    1744                 :             : 
    1745                 :             : /* Read ahead until the next character to be read is not whitespace.  */
    1746                 :             : 
    1747                 :             : void
    1748                 :   331728752 : gfc_gobble_whitespace (void)
    1749                 :             : {
    1750                 :   413563118 :   static int linenum = 0;
    1751                 :   413563118 :   locus old_loc;
    1752                 :   413563118 :   gfc_char_t c;
    1753                 :             : 
    1754                 :   413563118 :   do
    1755                 :             :     {
    1756                 :   413563118 :       old_loc = gfc_current_locus;
    1757                 :   413563118 :       c = gfc_next_char_literal (NONSTRING);
    1758                 :             :       /* Issue a warning for nonconforming tabs.  We keep track of the line
    1759                 :             :          number because the Fortran matchers will often back up and the same
    1760                 :             :          line will be scanned multiple times.  */
    1761                 :   413563118 :       if (warn_tabs && c == '\t')
    1762                 :             :         {
    1763                 :           6 :           int cur_linenum = LOCATION_LINE (gfc_current_locus.u.lb->location);
    1764                 :           6 :           if (cur_linenum != linenum)
    1765                 :             :             {
    1766                 :           2 :               linenum = cur_linenum;
    1767                 :           2 :               gfc_warning_now (OPT_Wtabs, "Nonconforming tab character at %C");
    1768                 :             :             }
    1769                 :             :         }
    1770                 :             :     }
    1771                 :   413563118 :   while (gfc_is_whitespace (c));
    1772                 :             : 
    1773                 :   331728752 :   if (!ISPRINT(c) && c != '\n' && last_error_char != gfc_current_locus.nextc)
    1774                 :             :     {
    1775                 :           2 :       char buf[20];
    1776                 :           2 :       last_error_char = gfc_current_locus.nextc;
    1777                 :           2 :       snprintf (buf, 20, "%2.2X", c);
    1778                 :           2 :       gfc_error_now ("Invalid character 0x%s at %C", buf);
    1779                 :             :     }
    1780                 :             : 
    1781                 :   331728752 :   gfc_current_locus = old_loc;
    1782                 :   331728752 : }
    1783                 :             : 
    1784                 :             : 
    1785                 :             : /* Load a single line into pbuf.
    1786                 :             : 
    1787                 :             :    If pbuf points to a NULL pointer, it is allocated.
    1788                 :             :    We truncate lines that are too long, unless we're dealing with
    1789                 :             :    preprocessor lines or if the option -ffixed-line-length-none is set,
    1790                 :             :    in which case we reallocate the buffer to fit the entire line, if
    1791                 :             :    need be.
    1792                 :             :    In fixed mode, we expand a tab that occurs within the statement
    1793                 :             :    label region to expand to spaces that leave the next character in
    1794                 :             :    the source region.
    1795                 :             : 
    1796                 :             :    If first_char is not NULL, it's a pointer to a single char value holding
    1797                 :             :    the first character of the line, which has already been read by the
    1798                 :             :    caller.  This avoids the use of ungetc().
    1799                 :             : 
    1800                 :             :    load_line returns whether the line was truncated.
    1801                 :             : 
    1802                 :             :    NOTE: The error machinery isn't available at this point, so we can't
    1803                 :             :          easily report line and column numbers consistent with other
    1804                 :             :          parts of gfortran.  */
    1805                 :             : 
    1806                 :             : static bool
    1807                 :     6583433 : load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
    1808                 :             : {
    1809                 :     6583433 :   int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
    1810                 :     6583433 :   int quoted = ' ', comment_ix = -1;
    1811                 :     6583433 :   bool seen_comment = false;
    1812                 :     6583433 :   bool first_comment = true;
    1813                 :     6583433 :   bool trunc_flag = false;
    1814                 :     6583433 :   bool seen_printable = false;
    1815                 :     6583433 :   bool seen_ampersand = false;
    1816                 :     6583433 :   bool found_tab = false;
    1817                 :     6583433 :   bool warned_tabs = false;
    1818                 :     6583433 :   gfc_char_t *buffer;
    1819                 :             : 
    1820                 :             :   /* Determine the maximum allowed line length.  */
    1821                 :     6583433 :   if (gfc_current_form == FORM_FREE)
    1822                 :     6235857 :     maxlen = flag_free_line_length;
    1823                 :      347576 :   else if (gfc_current_form == FORM_FIXED)
    1824                 :      347576 :     maxlen = flag_fixed_line_length;
    1825                 :             :   else
    1826                 :             :     maxlen = 72;
    1827                 :             : 
    1828                 :     6583433 :   if (*pbuf == NULL)
    1829                 :             :     {
    1830                 :             :       /* Allocate the line buffer, storing its length into buflen.
    1831                 :             :          Note that if maxlen==0, indicating that arbitrary-length lines
    1832                 :             :          are allowed, the buffer will be reallocated if this length is
    1833                 :             :          insufficient; since 132 characters is the length of a standard
    1834                 :             :          free-form line, we use that as a starting guess.  */
    1835                 :       61229 :       if (maxlen > 0)
    1836                 :             :         buflen = maxlen;
    1837                 :             :       else
    1838                 :         308 :         buflen = 132;
    1839                 :             : 
    1840                 :       61229 :       *pbuf = gfc_get_wide_string (buflen + 1);
    1841                 :             :     }
    1842                 :             : 
    1843                 :     6583433 :   i = 0;
    1844                 :     6583433 :   buffer = *pbuf;
    1845                 :             : 
    1846                 :     6583433 :   if (first_char)
    1847                 :           6 :     c = *first_char;
    1848                 :             :   else
    1849                 :     6583427 :     c = getc (input);
    1850                 :             : 
    1851                 :             :   /* In order to not truncate preprocessor lines, we have to
    1852                 :             :      remember that this is one.  */
    1853                 :     6583433 :   preprocessor_flag = (c == '#');
    1854                 :             : 
    1855                 :   286565868 :   for (;;)
    1856                 :             :     {
    1857                 :   286565868 :       if (c == EOF)
    1858                 :             :         break;
    1859                 :             : 
    1860                 :             :       if (c == '\n')
    1861                 :             :         {
    1862                 :             :           /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
    1863                 :     6522082 :           if (gfc_current_form == FORM_FREE
    1864                 :     6178147 :               && !seen_printable && seen_ampersand)
    1865                 :             :             {
    1866                 :           9 :               if (pedantic)
    1867                 :           0 :                 gfc_error_now ("%<&%> not allowed by itself in line %d",
    1868                 :             :                                current_file->line);
    1869                 :             :               else
    1870                 :           9 :                 gfc_warning_now (0, "%<&%> not allowed by itself in line %d",
    1871                 :             :                                  current_file->line);
    1872                 :             :             }
    1873                 :             :           break;
    1874                 :             :         }
    1875                 :             : 
    1876                 :             :       if (c == '\r' || c == '\0')
    1877                 :       10955 :         goto next_char;                 /* Gobble characters.  */
    1878                 :             : 
    1879                 :             :       if (c == '&')
    1880                 :             :         {
    1881                 :       38407 :           if (seen_ampersand)
    1882                 :             :             {
    1883                 :             :               seen_ampersand = false;
    1884                 :             :               seen_printable = true;
    1885                 :             :             }
    1886                 :             :           else
    1887                 :       35981 :             seen_ampersand = true;
    1888                 :             :         }
    1889                 :             : 
    1890                 :   279971480 :       if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
    1891                 :   243755330 :         seen_printable = true;
    1892                 :             : 
    1893                 :             :       /* Is this a fixed-form comment?  */
    1894                 :   279971480 :       if (gfc_current_form == FORM_FIXED && i == 0
    1895                 :      329089 :           && (c == '*' || c == 'c' || c == 'C'
    1896                 :      315009 :               || (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))))
    1897                 :             :         {
    1898                 :   279971480 :           seen_comment = true;
    1899                 :   279971480 :           comment_ix = i;
    1900                 :             :         }
    1901                 :             : 
    1902                 :   279971480 :       if (quoted == ' ')
    1903                 :             :         {
    1904                 :   258346419 :           if (c == '\'' || c == '"')
    1905                 :   279971480 :             quoted = c;
    1906                 :             :         }
    1907                 :    21625061 :       else if (c == quoted)
    1908                 :   258336917 :         quoted = ' ';
    1909                 :             : 
    1910                 :             :       /* Is this a free-form comment?  */
    1911                 :   279971480 :       if (c == '!' && quoted == ' ')
    1912                 :             :         {
    1913                 :     4101433 :           if (seen_comment)
    1914                 :             :             first_comment = false;
    1915                 :             :           seen_comment = true;
    1916                 :             :           comment_ix = i;
    1917                 :             :         }
    1918                 :             : 
    1919                 :             :       /* For truncation and tab warnings, set seen_comment to false if one has
    1920                 :             :          either an OpenMP or OpenACC directive - or a !GCC$ attribute.  If
    1921                 :             :          OpenMP is enabled, use '!$' as conditional compilation sentinel
    1922                 :             :          and OpenMP directive ('!$omp').  */
    1923                 :   279966644 :       if (seen_comment && first_comment && flag_openmp && comment_ix + 1 == i
    1924                 :      410968 :           && c == '$')
    1925                 :             :         first_comment = seen_comment = false;
    1926                 :   279937013 :       if (seen_comment && first_comment && comment_ix + 4 == i)
    1927                 :             :         {
    1928                 :     3939245 :           if (((*pbuf)[comment_ix+1] == 'g' || (*pbuf)[comment_ix+1] == 'G')
    1929                 :     3290572 :               && ((*pbuf)[comment_ix+2] == 'c' || (*pbuf)[comment_ix+2] == 'C')
    1930                 :     3288513 :               && ((*pbuf)[comment_ix+3] == 'c' || (*pbuf)[comment_ix+3] == 'C')
    1931                 :     3288513 :               && c == '$')
    1932                 :     3939245 :             first_comment = seen_comment = false;
    1933                 :     3939245 :           if (flag_openacc
    1934                 :      212550 :               && (*pbuf)[comment_ix+1] == '$'
    1935                 :       20797 :               && ((*pbuf)[comment_ix+2] == 'a' || (*pbuf)[comment_ix+2] == 'A')
    1936                 :       20744 :               && ((*pbuf)[comment_ix+3] == 'c' || (*pbuf)[comment_ix+3] == 'C')
    1937                 :       20743 :               && (c == 'c' || c == 'C'))
    1938                 :   279971480 :             first_comment = seen_comment = false;
    1939                 :             :         }
    1940                 :             : 
    1941                 :             :       /* Vendor extension: "<tab>1" marks a continuation line.  */
    1942                 :   279971480 :       if (found_tab)
    1943                 :             :         {
    1944                 :         106 :           found_tab = false;
    1945                 :         106 :           if (c >= '1' && c <= '9')
    1946                 :             :             {
    1947                 :           1 :               *(buffer-1) = c;
    1948                 :           1 :               goto next_char;
    1949                 :             :             }
    1950                 :             :         }
    1951                 :             : 
    1952                 :   279971479 :       if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
    1953                 :             :         {
    1954                 :         106 :           found_tab = true;
    1955                 :             : 
    1956                 :         106 :           if (warn_tabs && seen_comment == 0 && !warned_tabs)
    1957                 :             :             {
    1958                 :           4 :               warned_tabs = true;
    1959                 :           4 :               gfc_warning_now (OPT_Wtabs,
    1960                 :             :                                "Nonconforming tab character in column %d "
    1961                 :             :                                "of line %d", i + 1, current_file->line);
    1962                 :             :             }
    1963                 :             : 
    1964                 :         648 :           while (i < 6)
    1965                 :             :             {
    1966                 :         542 :               *buffer++ = ' ';
    1967                 :         542 :               i++;
    1968                 :             :             }
    1969                 :             : 
    1970                 :         106 :           goto next_char;
    1971                 :             :         }
    1972                 :             : 
    1973                 :   279971373 :       *buffer++ = c;
    1974                 :   279971373 :       i++;
    1975                 :             : 
    1976                 :   279971373 :       if (maxlen == 0 || preprocessor_flag)
    1977                 :             :         {
    1978                 :     3109930 :           if (i >= buflen)
    1979                 :             :             {
    1980                 :             :               /* Reallocate line buffer to double size to hold the
    1981                 :             :                 overlong line.  */
    1982                 :         231 :               buflen = buflen * 2;
    1983                 :         231 :               *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1));
    1984                 :         231 :               buffer = (*pbuf) + i;
    1985                 :             :             }
    1986                 :             :         }
    1987                 :   276861443 :       else if (i >= maxlen)
    1988                 :             :         {
    1989                 :             :           bool trunc_warn = true;
    1990                 :             : 
    1991                 :             :           /* Enhancement, if the very next non-space character is an ampersand
    1992                 :             :              or comment that we would otherwise warn about, don't mark as
    1993                 :             :              truncated.  */
    1994                 :             : 
    1995                 :             :           /* Truncate the rest of the line.  */
    1996                 :      111532 :           for (;;)
    1997                 :             :             {
    1998                 :      111532 :               c = getc (input);
    1999                 :      111532 :               if (c == '\r' || c == ' ')
    2000                 :       48097 :                 continue;
    2001                 :             : 
    2002                 :       63435 :               if (c == '\n' || c == EOF)
    2003                 :             :                 break;
    2004                 :             : 
    2005                 :       54988 :               if (!trunc_warn && c != '!')
    2006                 :             :                 trunc_warn = true;
    2007                 :             : 
    2008                 :       54988 :               if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&')
    2009                 :       53455 :                   || c == '!'))
    2010                 :             :                 trunc_warn = false;
    2011                 :             : 
    2012                 :           1 :               if (c == '!')
    2013                 :          65 :                 seen_comment = 1;
    2014                 :             : 
    2015                 :       54988 :               if (trunc_warn && !seen_comment)
    2016                 :        8452 :                 trunc_flag = 1;
    2017                 :             :             }
    2018                 :             : 
    2019                 :        8447 :           c = '\n';
    2020                 :        8447 :           continue;
    2021                 :        8447 :         }
    2022                 :             : 
    2023                 :   276852996 : next_char:
    2024                 :   279973988 :       c = getc (input);
    2025                 :             :     }
    2026                 :             : 
    2027                 :             :   /* Pad lines to the selected line length in fixed form.  */
    2028                 :     6583433 :   if (gfc_current_form == FORM_FIXED
    2029                 :      347576 :       && flag_fixed_line_length != 0
    2030                 :      343550 :       && flag_pad_source
    2031                 :      342728 :       && !preprocessor_flag
    2032                 :      342728 :       && c != EOF)
    2033                 :             :     {
    2034                 :     7922304 :       while (i++ < maxlen)
    2035                 :     7583496 :         *buffer++ = ' ';
    2036                 :             :     }
    2037                 :             : 
    2038                 :     6583433 :   *buffer = '\0';
    2039                 :     6583433 :   *pbuflen = buflen;
    2040                 :             : 
    2041                 :     6583433 :   return trunc_flag;
    2042                 :             : }
    2043                 :             : 
    2044                 :             : 
    2045                 :             : /* Get a gfc_file structure, initialize it and add it to
    2046                 :             :    the file stack.  */
    2047                 :             : 
    2048                 :             : static gfc_file *
    2049                 :       63352 : get_file (const char *name, enum lc_reason reason)
    2050                 :             : {
    2051                 :       63352 :   gfc_file *f;
    2052                 :             : 
    2053                 :       63352 :   f = XCNEW (gfc_file);
    2054                 :             : 
    2055                 :       63352 :   f->filename = xstrdup (name);
    2056                 :             : 
    2057                 :       63352 :   f->next = file_head;
    2058                 :       63352 :   file_head = f;
    2059                 :             : 
    2060                 :       63352 :   f->up = current_file;
    2061                 :       63352 :   if (current_file != NULL)
    2062                 :        2492 :     f->inclusion_line = current_file->line;
    2063                 :             : 
    2064                 :       63352 :   linemap_add (line_table, reason, false, f->filename, 1);
    2065                 :             : 
    2066                 :       63352 :   return f;
    2067                 :             : }
    2068                 :             : 
    2069                 :             : 
    2070                 :             : /* Deal with a line from the C preprocessor. The
    2071                 :             :    initial octothorp has already been seen.  */
    2072                 :             : 
    2073                 :             : static void
    2074                 :        8892 : preprocessor_line (gfc_char_t *c)
    2075                 :             : {
    2076                 :        8892 :   bool flag[5];
    2077                 :        8892 :   int i, line;
    2078                 :        8892 :   gfc_char_t *wide_filename;
    2079                 :        8892 :   gfc_file *f;
    2080                 :        8892 :   int escaped, unescape;
    2081                 :        8892 :   char *filename;
    2082                 :             : 
    2083                 :        8892 :   c++;
    2084                 :       17784 :   while (*c == ' ' || *c == '\t')
    2085                 :        8892 :     c++;
    2086                 :             : 
    2087                 :        8892 :   if (*c < '0' || *c > '9')
    2088                 :           2 :     goto bad_cpp_line;
    2089                 :             : 
    2090                 :        8890 :   line = wide_atoi (c);
    2091                 :             : 
    2092                 :        8890 :   c = wide_strchr (c, ' ');
    2093                 :        8890 :   if (c == NULL)
    2094                 :             :     {
    2095                 :             :       /* No file name given.  Set new line number.  */
    2096                 :           0 :       current_file->line = line;
    2097                 :        8890 :       return;
    2098                 :             :     }
    2099                 :             : 
    2100                 :             :   /* Skip spaces.  */
    2101                 :       17780 :   while (*c == ' ' || *c == '\t')
    2102                 :        8890 :     c++;
    2103                 :             : 
    2104                 :             :   /* Skip quote.  */
    2105                 :        8890 :   if (*c != '"')
    2106                 :           0 :     goto bad_cpp_line;
    2107                 :        8890 :   ++c;
    2108                 :             : 
    2109                 :        8890 :   wide_filename = c;
    2110                 :             : 
    2111                 :             :   /* Make filename end at quote.  */
    2112                 :        8890 :   unescape = 0;
    2113                 :        8890 :   escaped = false;
    2114                 :      425198 :   while (*c && ! (!escaped && *c == '"'))
    2115                 :             :     {
    2116                 :      416294 :       if (escaped)
    2117                 :             :         escaped = false;
    2118                 :      416294 :       else if (*c == '\\')
    2119                 :             :         {
    2120                 :          14 :           escaped = true;
    2121                 :          14 :           unescape++;
    2122                 :             :         }
    2123                 :      416308 :       ++c;
    2124                 :             :     }
    2125                 :             : 
    2126                 :        8890 :   if (! *c)
    2127                 :             :     /* Preprocessor line has no closing quote.  */
    2128                 :           0 :     goto bad_cpp_line;
    2129                 :             : 
    2130                 :        8890 :   *c++ = '\0';
    2131                 :             : 
    2132                 :             :   /* Undo effects of cpp_quote_string.  */
    2133                 :        8890 :   if (unescape)
    2134                 :             :     {
    2135                 :           2 :       gfc_char_t *s = wide_filename;
    2136                 :           2 :       gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape);
    2137                 :             : 
    2138                 :           2 :       wide_filename = d;
    2139                 :         118 :       while (*s)
    2140                 :             :         {
    2141                 :         114 :           if (*s == '\\')
    2142                 :          14 :             *d++ = *++s;
    2143                 :             :           else
    2144                 :         100 :             *d++ = *s;
    2145                 :         114 :           s++;
    2146                 :             :         }
    2147                 :           2 :       *d = '\0';
    2148                 :             :     }
    2149                 :             : 
    2150                 :             :   /* Get flags.  */
    2151                 :             : 
    2152                 :        8890 :   flag[1] = flag[2] = flag[3] = flag[4] = false;
    2153                 :             : 
    2154                 :       13151 :   for (;;)
    2155                 :             :     {
    2156                 :       13151 :       c = wide_strchr (c, ' ');
    2157                 :       13151 :       if (c == NULL)
    2158                 :             :         break;
    2159                 :             : 
    2160                 :        4261 :       c++;
    2161                 :        4261 :       i = wide_atoi (c);
    2162                 :             : 
    2163                 :        4261 :       if (i >= 1 && i <= 4)
    2164                 :        4261 :         flag[i] = true;
    2165                 :             :     }
    2166                 :             : 
    2167                 :             :   /* Convert the filename in wide characters into a filename in narrow
    2168                 :             :      characters.  */
    2169                 :        8890 :   filename = gfc_widechar_to_char (wide_filename, -1);
    2170                 :             : 
    2171                 :             :   /* Interpret flags.  */
    2172                 :             : 
    2173                 :        8890 :   if (flag[1]) /* Starting new file.  */
    2174                 :             :     {
    2175                 :        2129 :       f = get_file (filename, LC_RENAME);
    2176                 :        2129 :       add_file_change (f->filename, f->inclusion_line);
    2177                 :        2129 :       current_file = f;
    2178                 :             :     }
    2179                 :             : 
    2180                 :        8890 :   if (flag[2]) /* Ending current file.  */
    2181                 :             :     {
    2182                 :        2130 :       if (!current_file->up
    2183                 :        2130 :           || filename_cmp (current_file->up->filename, filename) != 0)
    2184                 :             :         {
    2185                 :           1 :           linemap_line_start (line_table, current_file->line, 80);
    2186                 :             :           /* ??? One could compute the exact column where the filename
    2187                 :             :              starts and compute the exact location here.  */
    2188                 :           1 :           gfc_warning_now_at (linemap_position_for_column (line_table, 1),
    2189                 :             :                               0, "file %qs left but not entered",
    2190                 :             :                               filename);
    2191                 :           1 :           current_file->line++;
    2192                 :           1 :           if (unescape)
    2193                 :           0 :             free (wide_filename);
    2194                 :           1 :           free (filename);
    2195                 :           1 :           return;
    2196                 :             :         }
    2197                 :             : 
    2198                 :        2129 :       add_file_change (NULL, line);
    2199                 :        2129 :       current_file = current_file->up;
    2200                 :        2129 :       linemap_add (line_table, LC_RENAME, false, current_file->filename,
    2201                 :        2129 :                    current_file->line);
    2202                 :             :     }
    2203                 :             : 
    2204                 :             :   /* The name of the file can be a temporary file produced by
    2205                 :             :      cpp. Replace the name if it is different.  */
    2206                 :             : 
    2207                 :        8889 :   if (filename_cmp (current_file->filename, filename) != 0)
    2208                 :             :     {
    2209                 :             :        /* FIXME: we leak the old filename because a pointer to it may be stored
    2210                 :             :           in the linemap.  Alternative could be using GC or updating linemap to
    2211                 :             :           point to the new name, but there is no API for that currently.  */
    2212                 :        3412 :       current_file->filename = xstrdup (filename);
    2213                 :             : 
    2214                 :             :       /* We need to tell the linemap API that the filename changed.  Just
    2215                 :             :          changing current_file is insufficient.  */
    2216                 :        3412 :       linemap_add (line_table, LC_RENAME, false, current_file->filename, line);
    2217                 :             :     }
    2218                 :             : 
    2219                 :             :   /* Set new line number.  */
    2220                 :        8889 :   current_file->line = line;
    2221                 :        8889 :   if (unescape)
    2222                 :           2 :     free (wide_filename);
    2223                 :        8889 :   free (filename);
    2224                 :        8889 :   return;
    2225                 :             : 
    2226                 :           2 :  bad_cpp_line:
    2227                 :           2 :   linemap_line_start (line_table, current_file->line, 80);
    2228                 :             :   /* ??? One could compute the exact column where the directive
    2229                 :             :      starts and compute the exact location here.  */
    2230                 :           2 :   gfc_warning_now_at (linemap_position_for_column (line_table, 2), 0,
    2231                 :             :                       "Illegal preprocessor directive");
    2232                 :           2 :   current_file->line++;
    2233                 :             : }
    2234                 :             : 
    2235                 :             : 
    2236                 :             : static void load_file (const char *, const char *, bool);
    2237                 :             : 
    2238                 :             : /* include_line()-- Checks a line buffer to see if it is an include
    2239                 :             :    line.  If so, we call load_file() recursively to load the included
    2240                 :             :    file.  We never return a syntax error because a statement like
    2241                 :             :    "include = 5" is perfectly legal.  We return 0 if no include was
    2242                 :             :    processed, 1 if we matched an include or -1 if include was
    2243                 :             :    partially processed, but will need continuation lines.  */
    2244                 :             : 
    2245                 :             : static int
    2246                 :     6513321 : include_line (gfc_char_t *line)
    2247                 :             : {
    2248                 :     6513321 :   gfc_char_t quote, *c, *begin, *stop;
    2249                 :     6513321 :   char *filename;
    2250                 :     6513321 :   const char *include = "include";
    2251                 :     6513321 :   bool allow_continuation = flag_dec_include;
    2252                 :     6513321 :   int i;
    2253                 :             : 
    2254                 :     6513321 :   c = line;
    2255                 :             : 
    2256                 :     6513321 :   if (flag_openmp || flag_openmp_simd)
    2257                 :             :     {
    2258                 :      638562 :       if (gfc_current_form == FORM_FREE)
    2259                 :             :         {
    2260                 :     1381070 :           while (*c == ' ' || *c == '\t')
    2261                 :      774654 :             c++;
    2262                 :      606416 :           if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
    2263                 :         265 :             c += 3;
    2264                 :             :         }
    2265                 :             :       else
    2266                 :             :         {
    2267                 :       32146 :           if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
    2268                 :       11112 :               && c[1] == '$' && c[2] == ' ')
    2269                 :          59 :             c += 3;
    2270                 :             :         }
    2271                 :             :     }
    2272                 :             : 
    2273                 :     6513321 :   if (gfc_current_form == FORM_FREE)
    2274                 :             :     {
    2275                 :     9705105 :       while (*c == ' ' || *c == '\t')
    2276                 :     3535346 :         c++;
    2277                 :     6169759 :       if (gfc_wide_strncasecmp (c, "include", 7))
    2278                 :             :         {
    2279                 :     6169478 :           if (!allow_continuation)
    2280                 :             :             return 0;
    2281                 :       37754 :           for (i = 0; i < 7; ++i)
    2282                 :             :             {
    2283                 :       37754 :               gfc_char_t c1 = gfc_wide_tolower (*c);
    2284                 :       37754 :               if (c1 != (unsigned char) include[i])
    2285                 :             :                 break;
    2286                 :        2333 :               c++;
    2287                 :             :             }
    2288                 :       35421 :           if (i == 0 || *c != '&')
    2289                 :             :             return 0;
    2290                 :           2 :           c++;
    2291                 :           4 :           while (*c == ' ' || *c == '\t')
    2292                 :           2 :             c++;
    2293                 :           2 :           if (*c == '\0' || *c == '!')
    2294                 :             :             return -1;
    2295                 :             :           return 0;
    2296                 :             :         }
    2297                 :             : 
    2298                 :         281 :       c += 7;
    2299                 :             :     }
    2300                 :             :   else
    2301                 :             :     {
    2302                 :     2033717 :       while (*c == ' ' || *c == '\t')
    2303                 :     1690155 :         c++;
    2304                 :      343562 :       if (flag_dec_include && *c == '0' && c - line == 5)
    2305                 :             :         {
    2306                 :           6 :           c++;
    2307                 :           6 :           while (*c == ' ' || *c == '\t')
    2308                 :           0 :             c++;
    2309                 :             :         }
    2310                 :      343562 :       if (c - line < 6)
    2311                 :      253076 :         allow_continuation = false;
    2312                 :      379611 :       for (i = 0; i < 7; ++i)
    2313                 :             :         {
    2314                 :      379529 :           gfc_char_t c1 = gfc_wide_tolower (*c);
    2315                 :      379529 :           if (c1 != (unsigned char) include[i])
    2316                 :             :             break;
    2317                 :       36049 :           c++;
    2318                 :       37138 :           while (*c == ' ' || *c == '\t')
    2319                 :        1089 :             c++;
    2320                 :             :         }
    2321                 :      343562 :       if (!allow_continuation)
    2322                 :             :         {
    2323                 :      343378 :           if (i != 7)
    2324                 :             :             return 0;
    2325                 :             :         }
    2326                 :         184 :       else if (i != 7)
    2327                 :             :         {
    2328                 :         173 :           if (i == 0)
    2329                 :             :             return 0;
    2330                 :             : 
    2331                 :             :           /* At the end of line or comment this might be continued.  */
    2332                 :          60 :           if (*c == '\0' || *c == '!')
    2333                 :             :             return -1;
    2334                 :             : 
    2335                 :             :           return 0;
    2336                 :             :         }
    2337                 :             :     }
    2338                 :             : 
    2339                 :         640 :   while (*c == ' ' || *c == '\t')
    2340                 :         277 :     c++;
    2341                 :             : 
    2342                 :             :   /* Find filename between quotes.  */
    2343                 :             : 
    2344                 :         363 :   quote = *c++;
    2345                 :         363 :   if (quote != '"' && quote != '\'')
    2346                 :             :     {
    2347                 :          15 :       if (allow_continuation)
    2348                 :             :         {
    2349                 :          15 :           if (gfc_current_form == FORM_FREE)
    2350                 :             :             {
    2351                 :           8 :               if (quote == '&')
    2352                 :             :                 {
    2353                 :           6 :                   while (*c == ' ' || *c == '\t')
    2354                 :           0 :                     c++;
    2355                 :           6 :                   if (*c == '\0' || *c == '!')
    2356                 :             :                     return -1;
    2357                 :             :                 }
    2358                 :             :             }
    2359                 :           7 :           else if (quote == '\0' || quote == '!')
    2360                 :             :             return -1;
    2361                 :             :         }
    2362                 :             :       return 0;
    2363                 :             :     }
    2364                 :             : 
    2365                 :             :   begin = c;
    2366                 :             : 
    2367                 :             :   bool cont = false;
    2368                 :        7418 :   while (*c != quote && *c != '\0')
    2369                 :             :     {
    2370                 :        7070 :       if (allow_continuation && gfc_current_form == FORM_FREE)
    2371                 :             :         {
    2372                 :        2145 :           if (*c == '&')
    2373                 :             :             cont = true;
    2374                 :        2143 :           else if (*c != ' ' && *c != '\t')
    2375                 :        7070 :             cont = false;
    2376                 :             :         }
    2377                 :        7070 :       c++;
    2378                 :             :     }
    2379                 :             : 
    2380                 :         348 :   if (*c == '\0')
    2381                 :             :     {
    2382                 :           4 :       if (allow_continuation
    2383                 :           4 :           && (cont || gfc_current_form != FORM_FREE))
    2384                 :             :         return -1;
    2385                 :             :       return 0;
    2386                 :             :     }
    2387                 :             : 
    2388                 :         344 :   stop = c++;
    2389                 :             : 
    2390                 :        3504 :   while (*c == ' ' || *c == '\t')
    2391                 :        3160 :     c++;
    2392                 :             : 
    2393                 :         344 :   if (*c != '\0' && *c != '!')
    2394                 :             :     return 0;
    2395                 :             : 
    2396                 :             :   /* We have an include line at this point.  */
    2397                 :             : 
    2398                 :         344 :   *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
    2399                 :             :                    read by anything else.  */
    2400                 :             : 
    2401                 :         344 :   filename = gfc_widechar_to_char (begin, -1);
    2402                 :         344 :   load_file (filename, NULL, false);
    2403                 :         341 :   free (filename);
    2404                 :         341 :   return 1;
    2405                 :             : }
    2406                 :             : 
    2407                 :             : /* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc.
    2408                 :             :    APIs.  Return 1 if recognized as valid INCLUDE statement and load_file has
    2409                 :             :    been called, 0 if it is not a valid INCLUDE statement and -1 if eof has
    2410                 :             :    been encountered while parsing it.  */
    2411                 :             : static int
    2412                 :          63 : include_stmt (gfc_linebuf *b)
    2413                 :             : {
    2414                 :          63 :   int ret = 0, i, length;
    2415                 :          63 :   const char *include = "include";
    2416                 :          63 :   gfc_char_t c, quote = 0;
    2417                 :          63 :   locus str_locus;
    2418                 :          63 :   char *filename;
    2419                 :             : 
    2420                 :          63 :   continue_flag = 0;
    2421                 :          63 :   end_flag = 0;
    2422                 :          63 :   gcc_attribute_flag = 0;
    2423                 :          63 :   openmp_flag = 0;
    2424                 :          63 :   openacc_flag = 0;
    2425                 :          63 :   continue_count = 0;
    2426                 :          63 :   continue_line = 0;
    2427                 :          63 :   gfc_current_locus.u.lb = b;
    2428                 :          63 :   gfc_current_locus.nextc = b->line;
    2429                 :             : 
    2430                 :          63 :   gfc_skip_comments ();
    2431                 :          63 :   gfc_gobble_whitespace ();
    2432                 :             : 
    2433                 :         509 :   for (i = 0; i < 7; i++)
    2434                 :             :     {
    2435                 :         405 :       c = gfc_next_char ();
    2436                 :         405 :       if (c != (unsigned char) include[i])
    2437                 :             :         {
    2438                 :          30 :           if (gfc_current_form == FORM_FIXED
    2439                 :          28 :               && i == 0
    2440                 :          28 :               && c == '0'
    2441                 :           8 :               && gfc_current_locus.nextc == b->line + 6)
    2442                 :             :             {
    2443                 :           8 :               gfc_gobble_whitespace ();
    2444                 :           8 :               i--;
    2445                 :           8 :               continue;
    2446                 :             :             }
    2447                 :          22 :           gcc_assert (i != 0);
    2448                 :          22 :           if (c == '\n')
    2449                 :             :             {
    2450                 :          22 :               gfc_advance_line ();
    2451                 :          22 :               gfc_skip_comments ();
    2452                 :          22 :               if (gfc_at_eof ())
    2453                 :          22 :                 ret = -1;
    2454                 :             :             }
    2455                 :          22 :           goto do_ret;
    2456                 :             :         }
    2457                 :             :     }
    2458                 :          41 :   gfc_gobble_whitespace ();
    2459                 :             : 
    2460                 :          41 :   c = gfc_next_char ();
    2461                 :          41 :   if (c == '\'' || c == '"')
    2462                 :          30 :     quote = c;
    2463                 :             :   else
    2464                 :             :     {
    2465                 :          11 :       if (c == '\n')
    2466                 :             :         {
    2467                 :          10 :           gfc_advance_line ();
    2468                 :          10 :           gfc_skip_comments ();
    2469                 :          10 :           if (gfc_at_eof ())
    2470                 :          11 :             ret = -1;
    2471                 :             :         }
    2472                 :          11 :       goto do_ret;
    2473                 :             :     }
    2474                 :             : 
    2475                 :          30 :   str_locus = gfc_current_locus;
    2476                 :          30 :   length = 0;
    2477                 :         710 :   do
    2478                 :             :     {
    2479                 :         370 :       c = gfc_next_char_literal (INSTRING_NOWARN);
    2480                 :         370 :       if (c == quote)
    2481                 :             :         break;
    2482                 :         348 :       if (c == '\n')
    2483                 :             :         {
    2484                 :           8 :           gfc_advance_line ();
    2485                 :           8 :           gfc_skip_comments ();
    2486                 :           8 :           if (gfc_at_eof ())
    2487                 :           8 :             ret = -1;
    2488                 :           8 :           goto do_ret;
    2489                 :             :         }
    2490                 :         340 :       length++;
    2491                 :             :     }
    2492                 :             :   while (1);
    2493                 :             : 
    2494                 :          22 :   gfc_gobble_whitespace ();
    2495                 :          22 :   c = gfc_next_char ();
    2496                 :          22 :   if (c != '\n')
    2497                 :           0 :     goto do_ret;
    2498                 :             : 
    2499                 :          22 :   gfc_current_locus = str_locus;
    2500                 :          22 :   ret = 1;
    2501                 :          22 :   filename = XNEWVEC (char, length + 1);
    2502                 :         343 :   for (i = 0; i < length; i++)
    2503                 :             :     {
    2504                 :         299 :       c = gfc_next_char_literal (INSTRING_WARN);
    2505                 :         299 :       gcc_assert (gfc_wide_fits_in_byte (c));
    2506                 :         299 :       filename[i] = (unsigned char) c;
    2507                 :             :     }
    2508                 :          22 :   filename[length] = '\0';
    2509                 :          22 :   load_file (filename, NULL, false);
    2510                 :          22 :   free (filename);
    2511                 :             : 
    2512                 :          63 : do_ret:
    2513                 :          63 :   continue_flag = 0;
    2514                 :          63 :   end_flag = 0;
    2515                 :          63 :   gcc_attribute_flag = 0;
    2516                 :          63 :   openmp_flag = 0;
    2517                 :          63 :   openacc_flag = 0;
    2518                 :          63 :   continue_count = 0;
    2519                 :          63 :   continue_line = 0;
    2520                 :          63 :   memset (&gfc_current_locus, '\0', sizeof (locus));
    2521                 :          63 :   memset (&openmp_locus, '\0', sizeof (locus));
    2522                 :          63 :   memset (&openacc_locus, '\0', sizeof (locus));
    2523                 :          63 :   memset (&gcc_attribute_locus, '\0', sizeof (locus));
    2524                 :          63 :   return ret;
    2525                 :             : }
    2526                 :             : 
    2527                 :             : 
    2528                 :             : 
    2529                 :             : /* Load a file into memory by calling load_line until the file ends.  */
    2530                 :             : 
    2531                 :             : static void
    2532                 :       61226 : load_file (const char *realfilename, const char *displayedname, bool initial)
    2533                 :             : {
    2534                 :       61226 :   gfc_char_t *line;
    2535                 :       61226 :   gfc_linebuf *b, *include_b = NULL;
    2536                 :       61226 :   gfc_file *f;
    2537                 :       61226 :   FILE *input;
    2538                 :       61226 :   int len, line_len;
    2539                 :       61226 :   bool first_line;
    2540                 :       61226 :   struct stat st;
    2541                 :       61226 :   int stat_result;
    2542                 :       61226 :   const char *filename;
    2543                 :             :   /* If realfilename and displayedname are different and non-null then
    2544                 :             :      surely realfilename is the preprocessed form of
    2545                 :             :      displayedname.  */
    2546                 :      182549 :   bool preprocessed_p = (realfilename && displayedname
    2547                 :       61226 :                          && strcmp (realfilename, displayedname));
    2548                 :             : 
    2549                 :       60097 :   filename = displayedname ? displayedname : realfilename;
    2550                 :             : 
    2551                 :       61595 :   for (f = current_file; f; f = f->up)
    2552                 :         369 :     if (filename_cmp (filename, f->filename) == 0)
    2553                 :           0 :       fatal_error (linemap_line_start (line_table, current_file->line, 0),
    2554                 :             :                    "File %qs is being included recursively", filename);
    2555                 :       61226 :   if (initial)
    2556                 :             :     {
    2557                 :       30431 :       if (gfc_src_file)
    2558                 :             :         {
    2559                 :           3 :           input = gfc_src_file;
    2560                 :           3 :           gfc_src_file = NULL;
    2561                 :             :         }
    2562                 :             :       else
    2563                 :       30428 :         input = gfc_open_file (realfilename);
    2564                 :             : 
    2565                 :       30431 :       if (input == NULL)
    2566                 :           0 :         gfc_fatal_error ("Cannot open file %qs", filename);
    2567                 :             :     }
    2568                 :             :   else
    2569                 :             :     {
    2570                 :       30795 :       input = gfc_open_included_file (realfilename, false, false);
    2571                 :       30795 :       if (input == NULL)
    2572                 :             :         {
    2573                 :             :           /* For -fpre-include file, current_file is NULL.  */
    2574                 :           1 :           if (current_file)
    2575                 :           1 :             fatal_error (linemap_line_start (line_table, current_file->line, 0),
    2576                 :             :                          "Cannot open included file %qs", filename);
    2577                 :             :           else
    2578                 :           0 :             gfc_fatal_error ("Cannot open pre-included file %qs", filename);
    2579                 :             :         }
    2580                 :       30794 :       stat_result = stat (realfilename, &st);
    2581                 :       30794 :       if (stat_result == 0 && !S_ISREG (st.st_mode))
    2582                 :             :         {
    2583                 :           2 :           fclose (input);
    2584                 :           2 :           if (current_file)
    2585                 :           2 :             fatal_error (linemap_line_start (line_table, current_file->line, 0),
    2586                 :             :                          "Included file %qs is not a regular file", filename);
    2587                 :             :           else
    2588                 :           0 :             gfc_fatal_error ("Included file %qs is not a regular file", filename);
    2589                 :             :         }
    2590                 :             :     }
    2591                 :             : 
    2592                 :             :   /* Load the file.
    2593                 :             : 
    2594                 :             :      A "non-initial" file means a file that is being included.  In
    2595                 :             :      that case we are creating an LC_ENTER map.
    2596                 :             : 
    2597                 :             :      An "initial" file means a main file; one that is not included.
    2598                 :             :      That file has already got at least one (surely more) line map(s)
    2599                 :             :      created by gfc_init.  So the subsequent map created in that case
    2600                 :             :      must have LC_RENAME reason.
    2601                 :             : 
    2602                 :             :      This latter case is not true for a preprocessed file.  In that
    2603                 :             :      case, although the file is "initial", the line maps created by
    2604                 :             :      gfc_init was used during the preprocessing of the file.  Now that
    2605                 :             :      the preprocessing is over and we are being fed the result of that
    2606                 :             :      preprocessing, we need to create a brand new line map for the
    2607                 :             :      preprocessed file, so the reason is going to be LC_ENTER.  */
    2608                 :             : 
    2609                 :       93144 :   f = get_file (filename, (initial && !preprocessed_p) ? LC_RENAME : LC_ENTER);
    2610                 :       61223 :   if (!initial)
    2611                 :       30792 :     add_file_change (f->filename, f->inclusion_line);
    2612                 :       61223 :   current_file = f;
    2613                 :       61223 :   current_file->line = 1;
    2614                 :       61223 :   line = NULL;
    2615                 :       61223 :   line_len = 0;
    2616                 :       61223 :   first_line = true;
    2617                 :             : 
    2618                 :       61223 :   if (initial && gfc_src_preprocessor_lines[0])
    2619                 :             :     {
    2620                 :           3 :       preprocessor_line (gfc_src_preprocessor_lines[0]);
    2621                 :           3 :       free (gfc_src_preprocessor_lines[0]);
    2622                 :           3 :       gfc_src_preprocessor_lines[0] = NULL;
    2623                 :           3 :       if (gfc_src_preprocessor_lines[1])
    2624                 :             :         {
    2625                 :           3 :           preprocessor_line (gfc_src_preprocessor_lines[1]);
    2626                 :           3 :           free (gfc_src_preprocessor_lines[1]);
    2627                 :           3 :           gfc_src_preprocessor_lines[1] = NULL;
    2628                 :             :         }
    2629                 :             :     }
    2630                 :             : 
    2631                 :     6583427 :   for (;;)
    2632                 :             :     {
    2633                 :     6583427 :       int trunc = load_line (input, &line, &line_len, NULL);
    2634                 :     6583427 :       int inc_line;
    2635                 :             : 
    2636                 :     6583427 :       len = gfc_wide_strlen (line);
    2637                 :     6583427 :       if (feof (input) && len == 0)
    2638                 :             :         break;
    2639                 :             : 
    2640                 :             :       /* If this is the first line of the file, it can contain a byte
    2641                 :             :          order mark (BOM), which we will ignore:
    2642                 :             :            FF FE is UTF-16 little endian,
    2643                 :             :            FE FF is UTF-16 big endian,
    2644                 :             :            EF BB BF is UTF-8.  */
    2645                 :     6522207 :       if (first_line
    2646                 :       65750 :           && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
    2647                 :           3 :                              && line[1] == (unsigned char) '\xFE')
    2648                 :       65747 :               || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
    2649                 :           1 :                                 && line[1] == (unsigned char) '\xFF')
    2650                 :       65746 :               || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
    2651                 :           2 :                                 && line[1] == (unsigned char) '\xBB'
    2652                 :           2 :                                 && line[2] == (unsigned char) '\xBF')))
    2653                 :             :         {
    2654                 :           6 :           int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
    2655                 :           6 :           gfc_char_t *new_char = gfc_get_wide_string (line_len);
    2656                 :             : 
    2657                 :           6 :           wide_strcpy (new_char, &line[n]);
    2658                 :           6 :           free (line);
    2659                 :           6 :           line = new_char;
    2660                 :           6 :           len -= n;
    2661                 :             :         }
    2662                 :             : 
    2663                 :             :       /* There are three things this line can be: a line of Fortran
    2664                 :             :          source, an include line or a C preprocessor directive.  */
    2665                 :             : 
    2666                 :     6522207 :       if (line[0] == '#')
    2667                 :             :         {
    2668                 :             :           /* When -g3 is specified, it's possible that we emit #define
    2669                 :             :              and #undef lines, which we need to pass to the middle-end
    2670                 :             :              so that it can emit correct debug info.  */
    2671                 :       17780 :           if (debug_info_level == DINFO_LEVEL_VERBOSE
    2672                 :        8894 :               && (wide_strncmp (line, "#define ", 8) == 0
    2673                 :          28 :                   || wide_strncmp (line, "#undef ", 7) == 0))
    2674                 :             :             ;
    2675                 :             :           else
    2676                 :             :             {
    2677                 :        8886 :               preprocessor_line (line);
    2678                 :        8886 :               continue;
    2679                 :             :             }
    2680                 :             :         }
    2681                 :             : 
    2682                 :             :       /* Preprocessed files have preprocessor lines added before the byte
    2683                 :             :          order mark, so first_line is not about the first line of the file
    2684                 :             :          but the first line that's not a preprocessor line.  */
    2685                 :     6513321 :       first_line = false;
    2686                 :             : 
    2687                 :     6513321 :       inc_line = include_line (line);
    2688                 :     6513318 :       if (inc_line > 0)
    2689                 :             :         {
    2690                 :         341 :           current_file->line++;
    2691                 :         341 :           continue;
    2692                 :             :         }
    2693                 :             : 
    2694                 :             :       /* Add line.  */
    2695                 :             : 
    2696                 :     6512977 :       b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size
    2697                 :             :                     + (len + 1) * sizeof (gfc_char_t));
    2698                 :             : 
    2699                 :             : 
    2700                 :     6512977 :       b->location
    2701                 :     6512977 :         = linemap_line_start (line_table, current_file->line++, len);
    2702                 :             :       /* ??? We add the location for the maximum column possible here,
    2703                 :             :          because otherwise if the next call creates a new line-map, it
    2704                 :             :          will not reserve space for any offset.  */
    2705                 :     6512977 :       if (len > 0)
    2706                 :     5388153 :         linemap_position_for_column (line_table, len);
    2707                 :             : 
    2708                 :     6512977 :       b->file = current_file;
    2709                 :     6512977 :       b->truncated = trunc;
    2710                 :     6512977 :       wide_strcpy (b->line, line);
    2711                 :             : 
    2712                 :     6512977 :       if (line_head == NULL)
    2713                 :       30431 :         line_head = b;
    2714                 :             :       else
    2715                 :     6482546 :         line_tail->next = b;
    2716                 :             : 
    2717                 :     6512977 :       line_tail = b;
    2718                 :             : 
    2719                 :     6578739 :       while (file_changes_cur < file_changes_count)
    2720                 :       65762 :         file_changes[file_changes_cur++].lb = b;
    2721                 :             : 
    2722                 :     6512977 :       if (flag_dec_include)
    2723                 :             :         {
    2724                 :       37104 :           if (include_b && b != include_b)
    2725                 :             :             {
    2726                 :          63 :               int inc_line2 = include_stmt (include_b);
    2727                 :          63 :               if (inc_line2 == 0)
    2728                 :             :                 include_b = NULL;
    2729                 :          62 :               else if (inc_line2 > 0)
    2730                 :             :                 {
    2731                 :         146 :                   do
    2732                 :             :                     {
    2733                 :          84 :                       if (gfc_current_form == FORM_FIXED)
    2734                 :             :                         {
    2735                 :        3650 :                           for (gfc_char_t *p = include_b->line; *p; p++)
    2736                 :        3600 :                             *p = ' ';
    2737                 :             :                         }
    2738                 :             :                       else
    2739                 :          34 :                         include_b->line[0] = '\0';
    2740                 :          84 :                       if (include_b == b)
    2741                 :             :                         break;
    2742                 :          62 :                       include_b = include_b->next;
    2743                 :          62 :                     }
    2744                 :             :                   while (1);
    2745                 :             :                   include_b = NULL;
    2746                 :             :                 }
    2747                 :             :             }
    2748                 :       37104 :           if (inc_line == -1 && !include_b)
    2749                 :          23 :             include_b = b;
    2750                 :             :         }
    2751                 :             :     }
    2752                 :             : 
    2753                 :             :   /* Release the line buffer allocated in load_line.  */
    2754                 :       61220 :   free (line);
    2755                 :             : 
    2756                 :       61220 :   fclose (input);
    2757                 :             : 
    2758                 :       61220 :   if (!initial)
    2759                 :       30792 :     add_file_change (NULL, current_file->inclusion_line + 1);
    2760                 :       61220 :   current_file = current_file->up;
    2761                 :       61220 :   linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
    2762                 :       61220 : }
    2763                 :             : 
    2764                 :             : 
    2765                 :             : /* Open a new file and start scanning from that file. Returns true
    2766                 :             :    if everything went OK, false otherwise.  If form == FORM_UNKNOWN
    2767                 :             :    it tries to determine the source form from the filename, defaulting
    2768                 :             :    to free form.  */
    2769                 :             : 
    2770                 :             : void
    2771                 :       30444 : gfc_new_file (void)
    2772                 :             : {
    2773                 :       30444 :   if (flag_pre_include != NULL)
    2774                 :       30429 :     load_file (flag_pre_include, NULL, false);
    2775                 :             : 
    2776                 :       30444 :   if (gfc_cpp_enabled ())
    2777                 :             :     {
    2778                 :        1142 :       gfc_cpp_preprocess (gfc_source_file);
    2779                 :        1142 :       if (!gfc_cpp_preprocess_only ())
    2780                 :        1129 :         load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
    2781                 :             :     }
    2782                 :             :   else
    2783                 :       29302 :     load_file (gfc_source_file, NULL, true);
    2784                 :             : 
    2785                 :       30441 :   gfc_current_locus.u.lb = line_head;
    2786                 :       30441 :   gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
    2787                 :             : 
    2788                 :             : #if 0 /* Debugging aid.  */
    2789                 :             :   for (; line_head; line_head = line_head->next)
    2790                 :             :     printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
    2791                 :             :             LOCATION_LINE (line_head->location), line_head->line);
    2792                 :             : 
    2793                 :             :   exit (SUCCESS_EXIT_CODE);
    2794                 :             : #endif
    2795                 :       30441 : }
    2796                 :             : 
    2797                 :             : static char *
    2798                 :           6 : unescape_filename (const char *ptr)
    2799                 :             : {
    2800                 :           6 :   const char *p = ptr, *s;
    2801                 :           6 :   char *d, *ret;
    2802                 :           6 :   int escaped, unescape = 0;
    2803                 :             : 
    2804                 :             :   /* Make filename end at quote.  */
    2805                 :           6 :   escaped = false;
    2806                 :         248 :   while (*p && ! (! escaped && *p == '"'))
    2807                 :             :     {
    2808                 :         228 :       if (escaped)
    2809                 :             :         escaped = false;
    2810                 :         228 :       else if (*p == '\\')
    2811                 :             :         {
    2812                 :          14 :           escaped = true;
    2813                 :          14 :           unescape++;
    2814                 :             :         }
    2815                 :         242 :       ++p;
    2816                 :             :     }
    2817                 :             : 
    2818                 :           6 :   if (!*p || p[1])
    2819                 :             :     return NULL;
    2820                 :             : 
    2821                 :             :   /* Undo effects of cpp_quote_string.  */
    2822                 :           6 :   s = ptr;
    2823                 :           6 :   d = XCNEWVEC (char, p + 1 - ptr - unescape);
    2824                 :           6 :   ret = d;
    2825                 :             : 
    2826                 :         240 :   while (s != p)
    2827                 :             :     {
    2828                 :         228 :       if (*s == '\\')
    2829                 :          14 :         *d++ = *++s;
    2830                 :             :       else
    2831                 :         214 :         *d++ = *s;
    2832                 :         228 :       s++;
    2833                 :             :     }
    2834                 :           6 :   *d = '\0';
    2835                 :           6 :   return ret;
    2836                 :             : }
    2837                 :             : 
    2838                 :             : /* For preprocessed files, if the first tokens are of the form # NUM.
    2839                 :             :    handle the directives so we know the original file name.  */
    2840                 :             : 
    2841                 :             : const char *
    2842                 :           3 : gfc_read_orig_filename (const char *filename, const char **canon_source_file)
    2843                 :             : {
    2844                 :           3 :   int c, len;
    2845                 :           3 :   char *dirname, *tmp;
    2846                 :             : 
    2847                 :           3 :   gfc_src_file = gfc_open_file (filename);
    2848                 :           3 :   if (gfc_src_file == NULL)
    2849                 :             :     return NULL;
    2850                 :             : 
    2851                 :           3 :   c = getc (gfc_src_file);
    2852                 :             : 
    2853                 :           3 :   if (c != '#')
    2854                 :             :     return NULL;
    2855                 :             : 
    2856                 :           3 :   len = 0;
    2857                 :           3 :   load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c);
    2858                 :             : 
    2859                 :           3 :   if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
    2860                 :             :     return NULL;
    2861                 :             : 
    2862                 :           3 :   tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
    2863                 :           3 :   filename = unescape_filename (tmp);
    2864                 :           3 :   free (tmp);
    2865                 :           3 :   if (filename == NULL)
    2866                 :             :     return NULL;
    2867                 :             : 
    2868                 :           3 :   c = getc (gfc_src_file);
    2869                 :             : 
    2870                 :           3 :   if (c != '#')
    2871                 :             :     return filename;
    2872                 :             : 
    2873                 :           3 :   len = 0;
    2874                 :           3 :   load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c);
    2875                 :             : 
    2876                 :           3 :   if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
    2877                 :             :     return filename;
    2878                 :             : 
    2879                 :           3 :   tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
    2880                 :           3 :   dirname = unescape_filename (tmp);
    2881                 :           3 :   free (tmp);
    2882                 :           3 :   if (dirname == NULL)
    2883                 :             :     return filename;
    2884                 :             : 
    2885                 :           3 :   len = strlen (dirname);
    2886                 :           3 :   if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
    2887                 :             :     {
    2888                 :           1 :       free (dirname);
    2889                 :           1 :       return filename;
    2890                 :             :     }
    2891                 :           2 :   dirname[len - 2] = '\0';
    2892                 :           2 :   set_src_pwd (dirname);
    2893                 :             : 
    2894                 :           2 :   if (! IS_ABSOLUTE_PATH (filename))
    2895                 :             :     {
    2896                 :           2 :       char *p = XCNEWVEC (char, len + strlen (filename));
    2897                 :             : 
    2898                 :           2 :       memcpy (p, dirname, len - 2);
    2899                 :           2 :       p[len - 2] = '/';
    2900                 :           2 :       strcpy (p + len - 1, filename);
    2901                 :           2 :       *canon_source_file = p;
    2902                 :             :     }
    2903                 :             : 
    2904                 :           2 :   free (dirname);
    2905                 :           2 :   return filename;
    2906                 :             : }
        

Generated by: LCOV version 2.1-beta

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