2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
3 Free Software Foundation, Inc.
4 Contributed by Andy Vaught
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
22 /* Set of subroutines to (ultimately) return the next character to the
23 various matching subroutines. This file's job is to read files and
24 build up lines that are parsed by the parser. This means that we
25 handle continuation lines and "include" lines.
27 The first thing the scanner does is to load an entire file into
28 memory. We load the entire file into memory for a couple reasons.
29 The first is that we want to be able to deal with nonseekable input
30 (pipes, stdin) and there is a lot of backing up involved during
33 The second is that we want to be able to print the locus of errors,
34 and an error on line 999999 could conflict with something on line
35 one. Given nonseekable input, we've got to store the whole thing.
37 One thing that helps are the column truncation limits that give us
38 an upper bound on the size of individual lines. We don't store the
41 From the scanner's viewpoint, the higher level subroutines ask for
42 new characters and do a lot of jumping backwards. */
51 /* Structure for holding module and include file search path. */
52 typedef struct gfc_directorylist
56 struct gfc_directorylist *next;
60 /* List of include file search directories. */
61 static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
63 static gfc_file *file_head, *current_file;
65 static int continue_flag, end_flag, openmp_flag;
66 static int continue_count, continue_line;
67 static locus openmp_locus;
69 gfc_source_form gfc_current_form;
70 static gfc_linebuf *line_head, *line_tail;
72 locus gfc_current_locus;
73 const char *gfc_source_file;
74 static FILE *gfc_src_file;
75 static char *gfc_src_preprocessor_lines[2];
79 static struct gfc_file_change
85 size_t file_changes_cur, file_changes_count;
86 size_t file_changes_allocated;
88 /* Main scanner initialization. */
91 gfc_scanner_init_1 (void)
104 /* Main scanner destructor. */
107 gfc_scanner_done_1 (void)
112 while(line_head != NULL)
114 lb = line_head->next;
119 while(file_head != NULL)
122 gfc_free(file_head->filename);
129 /* Adds path to the list pointed to by list. */
132 add_path_to_list (gfc_directorylist **list, const char *path,
133 bool use_for_modules)
135 gfc_directorylist *dir;
139 while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
145 dir = *list = gfc_getmem (sizeof (gfc_directorylist));
151 dir->next = gfc_getmem (sizeof (gfc_directorylist));
156 dir->use_for_modules = use_for_modules;
157 dir->path = gfc_getmem (strlen (p) + 2);
158 strcpy (dir->path, p);
159 strcat (dir->path, "/"); /* make '/' last character */
164 gfc_add_include_path (const char *path, bool use_for_modules)
166 add_path_to_list (&include_dirs, path, use_for_modules);
171 gfc_add_intrinsic_modules_path (const char *path)
173 add_path_to_list (&intrinsic_modules_dirs, path, true);
177 /* Release resources allocated for options. */
180 gfc_release_include_path (void)
182 gfc_directorylist *p;
184 while (include_dirs != NULL)
187 include_dirs = include_dirs->next;
192 while (intrinsic_modules_dirs != NULL)
194 p = intrinsic_modules_dirs;
195 intrinsic_modules_dirs = intrinsic_modules_dirs->next;
200 gfc_free (gfc_option.module_dir);
205 open_included_file (const char *name, gfc_directorylist *list, bool module)
208 gfc_directorylist *p;
211 for (p = list; p; p = p->next)
213 if (module && !p->use_for_modules)
216 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
217 strcpy (fullname, p->path);
218 strcat (fullname, name);
220 f = gfc_open_file (fullname);
229 /* Opens file for reading, searching through the include directories
230 given if necessary. If the include_cwd argument is true, we try
231 to open the file in the current directory first. */
234 gfc_open_included_file (const char *name, bool include_cwd, bool module)
238 if (IS_ABSOLUTE_PATH (name))
239 return gfc_open_file (name);
243 f = gfc_open_file (name);
248 return open_included_file (name, include_dirs, module);
252 gfc_open_intrinsic_module (const char *name)
254 if (IS_ABSOLUTE_PATH (name))
255 return gfc_open_file (name);
257 return open_included_file (name, intrinsic_modules_dirs, true);
261 /* Test to see if we're at the end of the main source file. */
270 /* Test to see if we're at the end of the current file. */
278 if (line_head == NULL)
279 return 1; /* Null file */
281 if (gfc_current_locus.lb == NULL)
288 /* Test to see if we're at the beginning of a new line. */
296 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
300 /* Test to see if we're at the end of a line. */
308 return (*gfc_current_locus.nextc == '\0');
312 add_file_change (const char *filename, int line)
314 if (file_changes_count == file_changes_allocated)
316 if (file_changes_allocated)
317 file_changes_allocated *= 2;
319 file_changes_allocated = 16;
321 = xrealloc (file_changes,
322 file_changes_allocated * sizeof (*file_changes));
324 file_changes[file_changes_count].filename = filename;
325 file_changes[file_changes_count].lb = NULL;
326 file_changes[file_changes_count++].line = line;
330 report_file_change (gfc_linebuf *lb)
332 size_t c = file_changes_cur;
333 while (c < file_changes_count
334 && file_changes[c].lb == lb)
336 if (file_changes[c].filename)
337 (*debug_hooks->start_source_file) (file_changes[c].line,
338 file_changes[c].filename);
340 (*debug_hooks->end_source_file) (file_changes[c].line);
343 file_changes_cur = c;
347 gfc_start_source_files (void)
349 /* If the debugger wants the name of the main source file,
351 if (debug_hooks->start_end_main_source_file)
352 (*debug_hooks->start_source_file) (0, gfc_source_file);
354 file_changes_cur = 0;
355 report_file_change (gfc_current_locus.lb);
359 gfc_end_source_files (void)
361 report_file_change (NULL);
363 if (debug_hooks->start_end_main_source_file)
364 (*debug_hooks->end_source_file) (0);
367 /* Advance the current line pointer to the next line. */
370 gfc_advance_line (void)
375 if (gfc_current_locus.lb == NULL)
381 if (gfc_current_locus.lb->next
382 && !gfc_current_locus.lb->next->dbg_emitted)
384 report_file_change (gfc_current_locus.lb->next);
385 gfc_current_locus.lb->next->dbg_emitted = true;
388 gfc_current_locus.lb = gfc_current_locus.lb->next;
390 if (gfc_current_locus.lb != NULL)
391 gfc_current_locus.nextc = gfc_current_locus.lb->line;
394 gfc_current_locus.nextc = NULL;
400 /* Get the next character from the input, advancing gfc_current_file's
401 locus. When we hit the end of the line or the end of the file, we
402 start returning a '\n' in order to complete the current statement.
403 No Fortran line conventions are implemented here.
405 Requiring explicit advances to the next line prevents the parse
406 pointer from being on the wrong line if the current statement ends
414 if (gfc_current_locus.nextc == NULL)
417 c = (unsigned char) *gfc_current_locus.nextc++;
420 gfc_current_locus.nextc--; /* Remain on this line. */
428 /* Skip a comment. When we come here the parse pointer is positioned
429 immediately after the comment character. If we ever implement
430 compiler directives withing comments, here is where we parse the
434 skip_comment_line (void)
449 gfc_define_undef_line (void)
451 /* All lines beginning with '#' are either #define or #undef. */
452 if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_char () != '#')
455 if (strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
456 (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
457 &(gfc_current_locus.nextc[8]));
459 if (strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
460 (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
461 &(gfc_current_locus.nextc[7]));
463 /* Skip the rest of the line. */
464 skip_comment_line ();
470 /* Comment lines are null lines, lines containing only blanks or lines
471 on which the first nonblank line is a '!'.
472 Return true if !$ openmp conditional compilation sentinel was
476 skip_free_comments (void)
484 at_bol = gfc_at_bol ();
485 start = gfc_current_locus;
491 while (gfc_is_whitespace (c));
501 /* If -fopenmp, we need to handle here 2 things:
502 1) don't treat !$omp as comments, but directives
503 2) handle OpenMP conditional compilation, where
504 !$ should be treated as 2 spaces (for initial lines
505 only if followed by space). */
506 if (gfc_option.flag_openmp && at_bol)
508 locus old_loc = gfc_current_locus;
509 if (next_char () == '$')
512 if (c == 'o' || c == 'O')
514 if (((c = next_char ()) == 'm' || c == 'M')
515 && ((c = next_char ()) == 'p' || c == 'P'))
517 if ((c = next_char ()) == ' ' || continue_flag)
519 while (gfc_is_whitespace (c))
521 if (c != '\n' && c != '!')
524 openmp_locus = old_loc;
525 gfc_current_locus = start;
530 gfc_warning_now ("!$OMP at %C starts a commented "
531 "line as it neither is followed "
532 "by a space nor is a "
533 "continuation line");
535 gfc_current_locus = old_loc;
539 if (continue_flag || c == ' ')
541 gfc_current_locus = old_loc;
547 gfc_current_locus = old_loc;
549 skip_comment_line ();
556 if (openmp_flag && at_bol)
558 gfc_current_locus = start;
563 /* Skip comment lines in fixed source mode. We have the same rules as
564 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
565 in column 1, and a '!' cannot be in column 6. Also, we deal with
566 lines with 'd' or 'D' in column 1, if the user requested this. */
569 skip_fixed_comments (void)
577 start = gfc_current_locus;
582 while (gfc_is_whitespace (c));
587 skip_comment_line ();
592 gfc_current_locus = start;
599 start = gfc_current_locus;
610 if (c == '!' || c == 'c' || c == 'C' || c == '*')
612 /* If -fopenmp, we need to handle here 2 things:
613 1) don't treat !$omp|c$omp|*$omp as comments, but directives
614 2) handle OpenMP conditional compilation, where
615 !$|c$|*$ should be treated as 2 spaces if the characters
616 in columns 3 to 6 are valid fixed form label columns
618 if (gfc_option.flag_openmp)
620 if (next_char () == '$')
623 if (c == 'o' || c == 'O')
625 if (((c = next_char ()) == 'm' || c == 'M')
626 && ((c = next_char ()) == 'p' || c == 'P'))
630 && ((openmp_flag && continue_flag)
631 || c == ' ' || c == '0'))
634 while (gfc_is_whitespace (c))
636 if (c != '\n' && c != '!')
638 /* Canonicalize to *$omp. */
641 gfc_current_locus = start;
651 for (col = 3; col < 6; col++, c = next_char ())
654 else if (c < '0' || c > '9')
659 if (col == 6 && c != '\n'
660 && ((continue_flag && !digit_seen)
661 || c == ' ' || c == '0'))
663 gfc_current_locus = start;
664 start.nextc[0] = ' ';
665 start.nextc[1] = ' ';
670 gfc_current_locus = start;
672 skip_comment_line ();
676 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
678 if (gfc_option.flag_d_lines == 0)
680 skip_comment_line ();
684 *start.nextc = c = ' ';
689 while (gfc_is_whitespace (c))
701 if (col != 6 && c == '!')
703 skip_comment_line ();
711 gfc_current_locus = start;
715 /* Skips the current line if it is a comment. */
718 gfc_skip_comments (void)
720 if (gfc_current_form == FORM_FREE)
721 skip_free_comments ();
723 skip_fixed_comments ();
727 /* Get the next character from the input, taking continuation lines
728 and end-of-line comments into account. This implies that comment
729 lines between continued lines must be eaten here. For higher-level
730 subroutines, this flattens continued lines into a single logical
731 line. The in_string flag denotes whether we're inside a character
735 gfc_next_char_literal (int in_string)
738 int i, c, prev_openmp_flag;
750 if (gfc_current_form == FORM_FREE)
752 bool openmp_cond_flag;
754 if (!in_string && c == '!')
757 && memcmp (&gfc_current_locus, &openmp_locus,
758 sizeof (gfc_current_locus)) == 0)
761 /* This line can't be continued */
768 /* Avoid truncation warnings for comment ending lines. */
769 gfc_current_locus.lb->truncated = 0;
777 /* If the next nonblank character is a ! or \n, we've got a
778 continuation line. */
779 old_loc = gfc_current_locus;
782 while (gfc_is_whitespace (c))
785 /* Character constants to be continued cannot have commentary
788 if (in_string && c != '\n')
790 gfc_current_locus = old_loc;
795 if (c != '!' && c != '\n')
797 gfc_current_locus = old_loc;
802 prev_openmp_flag = openmp_flag;
805 skip_comment_line ();
810 goto not_continuation;
812 /* We've got a continuation line. If we are on the very next line after
813 the last continuation, increment the continuation line count and
814 check whether the limit has been exceeded. */
815 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
817 if (++continue_count == gfc_option.max_continue_free)
819 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
820 gfc_warning ("Limit of %d continuations exceeded in "
821 "statement at %C", gfc_option.max_continue_free);
824 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
826 /* Now find where it continues. First eat any comment lines. */
827 openmp_cond_flag = skip_free_comments ();
829 if (prev_openmp_flag != openmp_flag)
831 gfc_current_locus = old_loc;
832 openmp_flag = prev_openmp_flag;
837 /* Now that we have a non-comment line, probe ahead for the
838 first non-whitespace character. If it is another '&', then
839 reading starts at the next character, otherwise we must back
840 up to where the whitespace started and resume from there. */
842 old_loc = gfc_current_locus;
845 while (gfc_is_whitespace (c))
850 for (i = 0; i < 5; i++, c = next_char ())
852 gcc_assert (TOLOWER (c) == "!$omp"[i]);
854 old_loc = gfc_current_locus;
856 while (gfc_is_whitespace (c))
864 if (gfc_option.warn_ampersand)
865 gfc_warning_now ("Missing '&' in continued character "
867 gfc_current_locus.nextc--;
869 /* Both !$omp and !$ -fopenmp continuation lines have & on the
870 continuation line only optionally. */
871 else if (openmp_flag || openmp_cond_flag)
872 gfc_current_locus.nextc--;
876 gfc_current_locus = old_loc;
883 /* Fixed form continuation. */
884 if (!in_string && c == '!')
886 /* Skip comment at end of line. */
893 /* Avoid truncation warnings for comment ending lines. */
894 gfc_current_locus.lb->truncated = 0;
900 prev_openmp_flag = openmp_flag;
902 old_loc = gfc_current_locus;
905 skip_fixed_comments ();
907 /* See if this line is a continuation line. */
908 if (openmp_flag != prev_openmp_flag)
910 openmp_flag = prev_openmp_flag;
911 goto not_continuation;
915 for (i = 0; i < 5; i++)
919 goto not_continuation;
922 for (i = 0; i < 5; i++)
925 if (TOLOWER (c) != "*$omp"[i])
926 goto not_continuation;
930 if (c == '0' || c == ' ' || c == '\n')
931 goto not_continuation;
933 /* We've got a continuation line. If we are on the very next line after
934 the last continuation, increment the continuation line count and
935 check whether the limit has been exceeded. */
936 if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
938 if (++continue_count == gfc_option.max_continue_fixed)
940 if (gfc_notification_std (GFC_STD_GNU) || pedantic)
941 gfc_warning ("Limit of %d continuations exceeded in "
943 gfc_option.max_continue_fixed);
947 if (continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
948 continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
951 /* Ready to read first character of continuation line, which might
952 be another continuation line! */
957 gfc_current_locus = old_loc;
967 /* Get the next character of input, folded to lowercase. In fixed
968 form mode, we also ignore spaces. When matcher subroutines are
969 parsing character literals, they have to call
970 gfc_next_char_literal(). */
979 c = gfc_next_char_literal (0);
981 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
993 old_loc = gfc_current_locus;
994 c = gfc_next_char ();
995 gfc_current_locus = old_loc;
1001 /* Recover from an error. We try to get past the current statement
1002 and get lined up for the next. The next statement follows a '\n'
1003 or a ';'. We also assume that we are not within a character
1004 constant, and deal with finding a '\'' or '"'. */
1007 gfc_error_recovery (void)
1016 c = gfc_next_char ();
1017 if (c == '\n' || c == ';')
1020 if (c != '\'' && c != '"')
1049 /* Read ahead until the next character to be read is not whitespace. */
1052 gfc_gobble_whitespace (void)
1054 static int linenum = 0;
1060 old_loc = gfc_current_locus;
1061 c = gfc_next_char_literal (0);
1062 /* Issue a warning for nonconforming tabs. We keep track of the line
1063 number because the Fortran matchers will often back up and the same
1064 line will be scanned multiple times. */
1065 if (!gfc_option.warn_tabs && c == '\t')
1067 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
1068 if (cur_linenum != linenum)
1070 linenum = cur_linenum;
1071 gfc_warning_now ("Nonconforming tab character at %C");
1075 while (gfc_is_whitespace (c));
1077 gfc_current_locus = old_loc;
1081 /* Load a single line into pbuf.
1083 If pbuf points to a NULL pointer, it is allocated.
1084 We truncate lines that are too long, unless we're dealing with
1085 preprocessor lines or if the option -ffixed-line-length-none is set,
1086 in which case we reallocate the buffer to fit the entire line, if
1088 In fixed mode, we expand a tab that occurs within the statement
1089 label region to expand to spaces that leave the next character in
1091 load_line returns whether the line was truncated.
1093 NOTE: The error machinery isn't available at this point, so we can't
1094 easily report line and column numbers consistent with other
1095 parts of gfortran. */
1098 load_line (FILE *input, char **pbuf, int *pbuflen)
1100 static int linenum = 0, current_line = 1;
1101 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
1102 int trunc_flag = 0, seen_comment = 0;
1103 int seen_printable = 0, seen_ampersand = 0;
1105 bool found_tab = false;
1107 /* Determine the maximum allowed line length. */
1108 if (gfc_current_form == FORM_FREE)
1109 maxlen = gfc_option.free_line_length;
1110 else if (gfc_current_form == FORM_FIXED)
1111 maxlen = gfc_option.fixed_line_length;
1117 /* Allocate the line buffer, storing its length into buflen.
1118 Note that if maxlen==0, indicating that arbitrary-length lines
1119 are allowed, the buffer will be reallocated if this length is
1120 insufficient; since 132 characters is the length of a standard
1121 free-form line, we use that as a starting guess. */
1127 *pbuf = gfc_getmem (buflen + 1);
1133 preprocessor_flag = 0;
1136 /* In order to not truncate preprocessor lines, we have to
1137 remember that this is one. */
1138 preprocessor_flag = 1;
1149 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1150 if (gfc_current_form == FORM_FREE
1151 && !seen_printable && seen_ampersand)
1154 gfc_error_now ("'&' not allowed by itself in line %d",
1157 gfc_warning_now ("'&' not allowed by itself in line %d",
1164 continue; /* Gobble characters. */
1176 if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
1179 /* Is this a fixed-form comment? */
1180 if (gfc_current_form == FORM_FIXED && i == 0
1181 && (c == '*' || c == 'c' || c == 'd'))
1184 /* Vendor extension: "<tab>1" marks a continuation line. */
1188 if (c >= '1' && c <= '9')
1195 if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
1199 if (!gfc_option.warn_tabs && seen_comment == 0
1200 && current_line != linenum)
1202 linenum = current_line;
1203 gfc_warning_now ("Nonconforming tab character in column %d "
1204 "of line %d", i+1, linenum);
1219 if (maxlen == 0 || preprocessor_flag)
1223 /* Reallocate line buffer to double size to hold the
1225 buflen = buflen * 2;
1226 *pbuf = xrealloc (*pbuf, buflen + 1);
1227 buffer = (*pbuf) + i;
1230 else if (i >= maxlen)
1232 /* Truncate the rest of the line. */
1236 if (c == '\n' || c == EOF)
1242 ungetc ('\n', input);
1246 /* Pad lines to the selected line length in fixed form. */
1247 if (gfc_current_form == FORM_FIXED
1248 && gfc_option.fixed_line_length != 0
1249 && !preprocessor_flag
1252 while (i++ < maxlen)
1264 /* Get a gfc_file structure, initialize it and add it to
1268 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1272 f = gfc_getmem (sizeof (gfc_file));
1274 f->filename = gfc_getmem (strlen (name) + 1);
1275 strcpy (f->filename, name);
1277 f->next = file_head;
1280 f->up = current_file;
1281 if (current_file != NULL)
1282 f->inclusion_line = current_file->line;
1284 linemap_add (line_table, reason, false, f->filename, 1);
1289 /* Deal with a line from the C preprocessor. The
1290 initial octothorp has already been seen. */
1293 preprocessor_line (char *c)
1299 int escaped, unescape;
1302 while (*c == ' ' || *c == '\t')
1305 if (*c < '0' || *c > '9')
1310 c = strchr (c, ' ');
1313 /* No file name given. Set new line number. */
1314 current_file->line = line;
1319 while (*c == ' ' || *c == '\t')
1329 /* Make filename end at quote. */
1332 while (*c && ! (!escaped && *c == '"'))
1336 else if (*c == '\\')
1345 /* Preprocessor line has no closing quote. */
1350 /* Undo effects of cpp_quote_string. */
1354 char *d = gfc_getmem (c - filename - unescape);
1370 flag[1] = flag[2] = flag[3] = flag[4] = false;
1374 c = strchr (c, ' ');
1381 if (1 <= i && i <= 4)
1385 /* Interpret flags. */
1387 if (flag[1]) /* Starting new file. */
1389 f = get_file (filename, LC_RENAME);
1390 add_file_change (f->filename, f->inclusion_line);
1394 if (flag[2]) /* Ending current file. */
1396 if (!current_file->up
1397 || strcmp (current_file->up->filename, filename) != 0)
1399 gfc_warning_now ("%s:%d: file %s left but not entered",
1400 current_file->filename, current_file->line,
1403 gfc_free (filename);
1407 add_file_change (NULL, line);
1408 current_file = current_file->up;
1409 linemap_add (line_table, LC_RENAME, false, current_file->filename,
1410 current_file->line);
1413 /* The name of the file can be a temporary file produced by
1414 cpp. Replace the name if it is different. */
1416 if (strcmp (current_file->filename, filename) != 0)
1418 gfc_free (current_file->filename);
1419 current_file->filename = gfc_getmem (strlen (filename) + 1);
1420 strcpy (current_file->filename, filename);
1423 /* Set new line number. */
1424 current_file->line = line;
1426 gfc_free (filename);
1430 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1431 current_file->filename, current_file->line);
1432 current_file->line++;
1436 static try load_file (const char *, bool);
1438 /* include_line()-- Checks a line buffer to see if it is an include
1439 line. If so, we call load_file() recursively to load the included
1440 file. We never return a syntax error because a statement like
1441 "include = 5" is perfectly legal. We return false if no include was
1442 processed or true if we matched an include. */
1445 include_line (char *line)
1447 char quote, *c, *begin, *stop;
1451 if (gfc_option.flag_openmp)
1453 if (gfc_current_form == FORM_FREE)
1455 while (*c == ' ' || *c == '\t')
1457 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1462 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1463 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1468 while (*c == ' ' || *c == '\t')
1471 if (strncasecmp (c, "include", 7))
1475 while (*c == ' ' || *c == '\t')
1478 /* Find filename between quotes. */
1481 if (quote != '"' && quote != '\'')
1486 while (*c != quote && *c != '\0')
1494 while (*c == ' ' || *c == '\t')
1497 if (*c != '\0' && *c != '!')
1500 /* We have an include line at this point. */
1502 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1503 read by anything else. */
1505 load_file (begin, false);
1510 /* Load a file into memory by calling load_line until the file ends. */
1513 load_file (const char *filename, bool initial)
1522 for (f = current_file; f; f = f->up)
1523 if (strcmp (filename, f->filename) == 0)
1525 gfc_error_now ("File '%s' is being included recursively", filename);
1533 input = gfc_src_file;
1534 gfc_src_file = NULL;
1537 input = gfc_open_file (filename);
1540 gfc_error_now ("Can't open file '%s'", filename);
1546 input = gfc_open_included_file (filename, false, false);
1549 gfc_error_now ("Can't open included file '%s'", filename);
1554 /* Load the file. */
1556 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1558 add_file_change (f->filename, f->inclusion_line);
1560 current_file->line = 1;
1565 if (initial && gfc_src_preprocessor_lines[0])
1567 preprocessor_line (gfc_src_preprocessor_lines[0]);
1568 gfc_free (gfc_src_preprocessor_lines[0]);
1569 gfc_src_preprocessor_lines[0] = NULL;
1570 if (gfc_src_preprocessor_lines[1])
1572 preprocessor_line (gfc_src_preprocessor_lines[1]);
1573 gfc_free (gfc_src_preprocessor_lines[1]);
1574 gfc_src_preprocessor_lines[1] = NULL;
1580 int trunc = load_line (input, &line, &line_len);
1582 len = strlen (line);
1583 if (feof (input) && len == 0)
1586 /* If this is the first line of the file, it can contain a byte
1587 order mark (BOM), which we will ignore:
1588 FF FE is UTF-16 little endian,
1589 FE FF is UTF-16 big endian,
1590 EF BB BF is UTF-8. */
1592 && ((line_len >= 2 && line[0] == '\xFF' && line[1] == '\xFE')
1593 || (line_len >= 2 && line[0] == '\xFE' && line[1] == '\xFF')
1594 || (line_len >= 3 && line[0] == '\xEF' && line[1] == '\xBB'
1595 && line[2] == '\xBF')))
1597 int n = line[1] == '\xBB' ? 3 : 2;
1598 char * new = gfc_getmem (line_len);
1600 strcpy (new, line + n);
1606 /* There are three things this line can be: a line of Fortran
1607 source, an include line or a C preprocessor directive. */
1611 /* When -g3 is specified, it's possible that we emit #define
1612 and #undef lines, which we need to pass to the middle-end
1613 so that it can emit correct debug info. */
1614 if (debug_info_level == DINFO_LEVEL_VERBOSE
1615 && (strncmp (line, "#define ", 8) == 0
1616 || strncmp (line, "#undef ", 7) == 0))
1620 preprocessor_line (line);
1625 /* Preprocessed files have preprocessor lines added before the byte
1626 order mark, so first_line is not about the first line of the file
1627 but the first line that's not a preprocessor line. */
1630 if (include_line (line))
1632 current_file->line++;
1638 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1641 = linemap_line_start (line_table, current_file->line++, 120);
1642 b->file = current_file;
1643 b->truncated = trunc;
1644 strcpy (b->line, line);
1646 if (line_head == NULL)
1649 line_tail->next = b;
1653 while (file_changes_cur < file_changes_count)
1654 file_changes[file_changes_cur++].lb = b;
1657 /* Release the line buffer allocated in load_line. */
1663 add_file_change (NULL, current_file->inclusion_line + 1);
1664 current_file = current_file->up;
1665 linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
1670 /* Open a new file and start scanning from that file. Returns SUCCESS
1671 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1672 it tries to determine the source form from the filename, defaulting
1680 result = load_file (gfc_source_file, true);
1682 gfc_current_locus.lb = line_head;
1683 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1685 #if 0 /* Debugging aid. */
1686 for (; line_head; line_head = line_head->next)
1687 printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
1688 LOCATION_LINE (line_head->location), line_head->line);
1697 unescape_filename (const char *ptr)
1699 const char *p = ptr, *s;
1701 int escaped, unescape = 0;
1703 /* Make filename end at quote. */
1705 while (*p && ! (! escaped && *p == '"'))
1709 else if (*p == '\\')
1720 /* Undo effects of cpp_quote_string. */
1722 d = gfc_getmem (p + 1 - ptr - unescape);
1737 /* For preprocessed files, if the first tokens are of the form # NUM.
1738 handle the directives so we know the original file name. */
1741 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1746 gfc_src_file = gfc_open_file (filename);
1747 if (gfc_src_file == NULL)
1750 c = getc (gfc_src_file);
1751 ungetc (c, gfc_src_file);
1757 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1759 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1762 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1763 if (filename == NULL)
1766 c = getc (gfc_src_file);
1767 ungetc (c, gfc_src_file);
1773 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1775 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1778 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1779 if (dirname == NULL)
1782 len = strlen (dirname);
1783 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1788 dirname[len - 2] = '\0';
1789 set_src_pwd (dirname);
1791 if (! IS_ABSOLUTE_PATH (filename))
1793 char *p = gfc_getmem (len + strlen (filename));
1795 memcpy (p, dirname, len - 2);
1797 strcpy (p + len - 1, filename);
1798 *canon_source_file = p;