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

Generated by: LCOV version 1.0

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