2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
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 2, 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 COPYING. If not, write to the Free
20 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
23 /* Set of subroutines to (ultimately) return the next character to the
24 various matching subroutines. This file's job is to read files and
25 build up lines that are parsed by the parser. This means that we
26 handle continuation lines and "include" lines.
28 The first thing the scanner does is to load an entire file into
29 memory. We load the entire file into memory for a couple reasons.
30 The first is that we want to be able to deal with nonseekable input
31 (pipes, stdin) and there is a lot of backing up involved during
34 The second is that we want to be able to print the locus of errors,
35 and an error on line 999999 could conflict with something on line
36 one. Given nonseekable input, we've got to store the whole thing.
38 One thing that helps are the column truncation limits that give us
39 an upper bound on the size of individual lines. We don't store the
42 From the scanner's viewpoint, the higher level subroutines ask for
43 new characters and do a lot of jumping backwards. */
50 /* Structure for holding module and include file search path. */
51 typedef struct gfc_directorylist
54 struct gfc_directorylist *next;
58 /* List of include file search directories. */
59 static gfc_directorylist *include_dirs;
61 static gfc_file *file_head, *current_file;
63 static int continue_flag, end_flag, openmp_flag;
64 static int continue_count, continue_line;
65 static locus openmp_locus;
67 gfc_source_form gfc_current_form;
68 static gfc_linebuf *line_head, *line_tail;
70 locus gfc_current_locus;
71 const char *gfc_source_file;
72 static FILE *gfc_src_file;
73 static char *gfc_src_preprocessor_lines[2];
77 /* Main scanner initialization. */
80 gfc_scanner_init_1 (void)
93 /* Main scanner destructor. */
96 gfc_scanner_done_1 (void)
101 while(line_head != NULL)
103 lb = line_head->next;
108 while(file_head != NULL)
111 gfc_free(file_head->filename);
119 /* Adds path to the list pointed to by list. */
122 gfc_add_include_path (const char *path)
124 gfc_directorylist *dir;
128 while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */
135 dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
142 dir->next = gfc_getmem (sizeof (gfc_directorylist));
147 dir->path = gfc_getmem (strlen (p) + 2);
148 strcpy (dir->path, p);
149 strcat (dir->path, "/"); /* make '/' last character */
153 /* Release resources allocated for options. */
156 gfc_release_include_path (void)
158 gfc_directorylist *p;
160 gfc_free (gfc_option.module_dir);
161 while (include_dirs != NULL)
164 include_dirs = include_dirs->next;
170 /* Opens file for reading, searching through the include directories
171 given if necessary. If the include_cwd argument is true, we try
172 to open the file in the current directory first. */
175 gfc_open_included_file (const char *name, const bool include_cwd)
178 gfc_directorylist *p;
183 f = gfc_open_file (name);
188 for (p = include_dirs; p; p = p->next)
190 fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
191 strcpy (fullname, p->path);
192 strcat (fullname, name);
194 f = gfc_open_file (fullname);
202 /* Test to see if we're at the end of the main source file. */
212 /* Test to see if we're at the end of the current file. */
221 if (line_head == NULL)
222 return 1; /* Null file */
224 if (gfc_current_locus.lb == NULL)
231 /* Test to see if we're at the beginning of a new line. */
239 return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
243 /* Test to see if we're at the end of a line. */
252 return (*gfc_current_locus.nextc == '\0');
256 /* Advance the current line pointer to the next line. */
259 gfc_advance_line (void)
264 if (gfc_current_locus.lb == NULL)
270 gfc_current_locus.lb = gfc_current_locus.lb->next;
272 if (gfc_current_locus.lb != NULL)
273 gfc_current_locus.nextc = gfc_current_locus.lb->line;
276 gfc_current_locus.nextc = NULL;
282 /* Get the next character from the input, advancing gfc_current_file's
283 locus. When we hit the end of the line or the end of the file, we
284 start returning a '\n' in order to complete the current statement.
285 No Fortran line conventions are implemented here.
287 Requiring explicit advances to the next line prevents the parse
288 pointer from being on the wrong line if the current statement ends
296 if (gfc_current_locus.nextc == NULL)
299 c = *gfc_current_locus.nextc++;
302 gfc_current_locus.nextc--; /* Remain on this line. */
309 /* Skip a comment. When we come here the parse pointer is positioned
310 immediately after the comment character. If we ever implement
311 compiler directives withing comments, here is where we parse the
315 skip_comment_line (void)
329 /* Comment lines are null lines, lines containing only blanks or lines
330 on which the first nonblank line is a '!'.
331 Return true if !$ openmp conditional compilation sentinel was
335 skip_free_comments (void)
343 at_bol = gfc_at_bol ();
344 start = gfc_current_locus;
350 while (gfc_is_whitespace (c));
360 /* If -fopenmp, we need to handle here 2 things:
361 1) don't treat !$omp as comments, but directives
362 2) handle OpenMP conditional compilation, where
363 !$ should be treated as 2 spaces (for initial lines
364 only if followed by space). */
365 if (gfc_option.flag_openmp && at_bol)
367 locus old_loc = gfc_current_locus;
368 if (next_char () == '$')
371 if (c == 'o' || c == 'O')
373 if (((c = next_char ()) == 'm' || c == 'M')
374 && ((c = next_char ()) == 'p' || c == 'P')
375 && ((c = next_char ()) == ' ' || continue_flag))
377 while (gfc_is_whitespace (c))
379 if (c != '\n' && c != '!')
382 openmp_locus = old_loc;
383 gfc_current_locus = start;
387 gfc_current_locus = old_loc;
391 if (continue_flag || c == ' ')
393 gfc_current_locus = old_loc;
399 gfc_current_locus = old_loc;
401 skip_comment_line ();
408 if (openmp_flag && at_bol)
410 gfc_current_locus = start;
415 /* Skip comment lines in fixed source mode. We have the same rules as
416 in skip_free_comment(), except that we can have a 'c', 'C' or '*'
417 in column 1, and a '!' cannot be in column 6. Also, we deal with
418 lines with 'd' or 'D' in column 1, if the user requested this. */
421 skip_fixed_comments (void)
429 start = gfc_current_locus;
434 while (gfc_is_whitespace (c));
439 skip_comment_line ();
444 gfc_current_locus = start;
451 start = gfc_current_locus;
462 if (c == '!' || c == 'c' || c == 'C' || c == '*')
464 /* If -fopenmp, we need to handle here 2 things:
465 1) don't treat !$omp|c$omp|*$omp as comments, but directives
466 2) handle OpenMP conditional compilation, where
467 !$|c$|*$ should be treated as 2 spaces if the characters
468 in columns 3 to 6 are valid fixed form label columns
470 if (gfc_option.flag_openmp)
472 if (next_char () == '$')
475 if (c == 'o' || c == 'O')
477 if (((c = next_char ()) == 'm' || c == 'M')
478 && ((c = next_char ()) == 'p' || c == 'P'))
482 && ((openmp_flag && continue_flag)
483 || c == ' ' || c == '0'))
486 while (gfc_is_whitespace (c))
488 if (c != '\n' && c != '!')
490 /* Canonicalize to *$omp. */
493 gfc_current_locus = start;
503 for (col = 3; col < 6; col++, c = next_char ())
506 else if (c < '0' || c > '9')
511 if (col == 6 && c != '\n'
512 && ((continue_flag && !digit_seen)
513 || c == ' ' || c == '0'))
515 gfc_current_locus = start;
516 start.nextc[0] = ' ';
517 start.nextc[1] = ' ';
522 gfc_current_locus = start;
524 skip_comment_line ();
528 if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
530 if (gfc_option.flag_d_lines == 0)
532 skip_comment_line ();
536 *start.nextc = c = ' ';
541 while (gfc_is_whitespace (c))
553 if (col != 6 && c == '!')
555 skip_comment_line ();
563 gfc_current_locus = start;
567 /* Skips the current line if it is a comment. */
570 gfc_skip_comments (void)
572 if (gfc_current_form == FORM_FREE)
573 skip_free_comments ();
575 skip_fixed_comments ();
579 /* Get the next character from the input, taking continuation lines
580 and end-of-line comments into account. This implies that comment
581 lines between continued lines must be eaten here. For higher-level
582 subroutines, this flattens continued lines into a single logical
583 line. The in_string flag denotes whether we're inside a character
587 gfc_next_char_literal (int in_string)
590 int i, c, prev_openmp_flag;
602 if (gfc_current_form == FORM_FREE)
604 bool openmp_cond_flag;
606 if (!in_string && c == '!')
609 && memcmp (&gfc_current_locus, &openmp_locus,
610 sizeof (gfc_current_locus)) == 0)
613 /* This line can't be continued */
620 /* Avoid truncation warnings for comment ending lines. */
621 gfc_current_locus.lb->truncated = 0;
629 /* If the next nonblank character is a ! or \n, we've got a
630 continuation line. */
631 old_loc = gfc_current_locus;
634 while (gfc_is_whitespace (c))
637 /* Character constants to be continued cannot have commentary
640 if (in_string && c != '\n')
642 gfc_current_locus = old_loc;
647 if (c != '!' && c != '\n')
649 gfc_current_locus = old_loc;
654 prev_openmp_flag = openmp_flag;
657 skip_comment_line ();
661 /* We've got a continuation line. If we are on the very next line after
662 the last continuation, increment the continuation line count and
663 check whether the limit has been exceeded. */
664 if (gfc_current_locus.lb->linenum == continue_line + 1)
666 if (++continue_count == gfc_option.max_continue_free)
668 if (gfc_notification_std (GFC_STD_GNU)
670 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
671 gfc_option.max_continue_free);
674 continue_line = gfc_current_locus.lb->linenum;
676 /* Now find where it continues. First eat any comment lines. */
677 openmp_cond_flag = skip_free_comments ();
679 if (prev_openmp_flag != openmp_flag)
681 gfc_current_locus = old_loc;
682 openmp_flag = prev_openmp_flag;
687 /* Now that we have a non-comment line, probe ahead for the
688 first non-whitespace character. If it is another '&', then
689 reading starts at the next character, otherwise we must back
690 up to where the whitespace started and resume from there. */
692 old_loc = gfc_current_locus;
695 while (gfc_is_whitespace (c))
700 for (i = 0; i < 5; i++, c = next_char ())
702 gcc_assert (TOLOWER (c) == "!$omp"[i]);
704 old_loc = gfc_current_locus;
706 while (gfc_is_whitespace (c))
714 if (gfc_option.warn_ampersand)
715 gfc_warning_now ("Missing '&' in continued character constant at %C");
716 gfc_current_locus.nextc--;
718 /* Both !$omp and !$ -fopenmp continuation lines have & on the
719 continuation line only optionally. */
720 else if (openmp_flag || openmp_cond_flag)
721 gfc_current_locus.nextc--;
725 gfc_current_locus = old_loc;
732 /* Fixed form continuation. */
733 if (!in_string && c == '!')
735 /* Skip comment at end of line. */
742 /* Avoid truncation warnings for comment ending lines. */
743 gfc_current_locus.lb->truncated = 0;
749 prev_openmp_flag = openmp_flag;
751 old_loc = gfc_current_locus;
754 skip_fixed_comments ();
756 /* See if this line is a continuation line. */
757 if (openmp_flag != prev_openmp_flag)
759 openmp_flag = prev_openmp_flag;
760 goto not_continuation;
764 for (i = 0; i < 5; i++)
768 goto not_continuation;
771 for (i = 0; i < 5; i++)
774 if (TOLOWER (c) != "*$omp"[i])
775 goto not_continuation;
779 if (c == '0' || c == ' ' || c == '\n')
780 goto not_continuation;
782 /* We've got a continuation line. If we are on the very next line after
783 the last continuation, increment the continuation line count and
784 check whether the limit has been exceeded. */
785 if (gfc_current_locus.lb->linenum == continue_line + 1)
787 if (++continue_count == gfc_option.max_continue_fixed)
789 if (gfc_notification_std (GFC_STD_GNU)
791 gfc_warning ("Limit of %d continuations exceeded in statement at %C",
792 gfc_option.max_continue_fixed);
796 if (continue_line < gfc_current_locus.lb->linenum)
797 continue_line = gfc_current_locus.lb->linenum;
800 /* Ready to read first character of continuation line, which might
801 be another continuation line! */
806 gfc_current_locus = old_loc;
816 /* Get the next character of input, folded to lowercase. In fixed
817 form mode, we also ignore spaces. When matcher subroutines are
818 parsing character literals, they have to call
819 gfc_next_char_literal(). */
828 c = gfc_next_char_literal (0);
830 while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
842 old_loc = gfc_current_locus;
843 c = gfc_next_char ();
844 gfc_current_locus = old_loc;
850 /* Recover from an error. We try to get past the current statement
851 and get lined up for the next. The next statement follows a '\n'
852 or a ';'. We also assume that we are not within a character
853 constant, and deal with finding a '\'' or '"'. */
856 gfc_error_recovery (void)
865 c = gfc_next_char ();
866 if (c == '\n' || c == ';')
869 if (c != '\'' && c != '"')
898 /* Read ahead until the next character to be read is not whitespace. */
901 gfc_gobble_whitespace (void)
903 static int linenum = 0;
909 old_loc = gfc_current_locus;
910 c = gfc_next_char_literal (0);
911 /* Issue a warning for nonconforming tabs. We keep track of the line
912 number because the Fortran matchers will often back up and the same
913 line will be scanned multiple times. */
914 if (!gfc_option.warn_tabs && c == '\t')
916 #ifdef USE_MAPPED_LOCATION
917 int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
919 int cur_linenum = gfc_current_locus.lb->linenum;
921 if (cur_linenum != linenum)
923 linenum = cur_linenum;
924 gfc_warning_now ("Nonconforming tab character at %C");
928 while (gfc_is_whitespace (c));
930 gfc_current_locus = old_loc;
934 /* Load a single line into pbuf.
936 If pbuf points to a NULL pointer, it is allocated.
937 We truncate lines that are too long, unless we're dealing with
938 preprocessor lines or if the option -ffixed-line-length-none is set,
939 in which case we reallocate the buffer to fit the entire line, if
941 In fixed mode, we expand a tab that occurs within the statement
942 label region to expand to spaces that leave the next character in
944 load_line returns whether the line was truncated.
946 NOTE: The error machinery isn't available at this point, so we can't
947 easily report line and column numbers consistent with other
948 parts of gfortran. */
951 load_line (FILE * input, char **pbuf, int *pbuflen)
953 static int linenum = 0, current_line = 1;
954 int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
955 int trunc_flag = 0, seen_comment = 0;
956 int seen_printable = 0, seen_ampersand = 0;
959 /* Determine the maximum allowed line length. */
960 if (gfc_current_form == FORM_FREE)
961 maxlen = gfc_option.free_line_length;
962 else if (gfc_current_form == FORM_FIXED)
963 maxlen = gfc_option.fixed_line_length;
969 /* Allocate the line buffer, storing its length into buflen.
970 Note that if maxlen==0, indicating that arbitrary-length lines
971 are allowed, the buffer will be reallocated if this length is
972 insufficient; since 132 characters is the length of a standard
973 free-form line, we use that as a starting guess. */
979 *pbuf = gfc_getmem (buflen + 1);
985 preprocessor_flag = 0;
988 /* In order to not truncate preprocessor lines, we have to
989 remember that this is one. */
990 preprocessor_flag = 1;
1001 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1002 if (gfc_current_form == FORM_FREE
1003 && !seen_printable && seen_ampersand)
1007 ("'&' not allowed by itself in line %d", current_line);
1010 ("'&' not allowed by itself in line %d", current_line);
1016 continue; /* Gobble characters. */
1022 /* Ctrl-Z ends the file. */
1023 while (fgetc (input) != EOF);
1027 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1031 if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1034 if (gfc_current_form == FORM_FREE
1035 && c == '!' && !seen_printable && seen_ampersand)
1039 "'&' not allowed by itself with comment in line %d", current_line);
1042 "'&' not allowed by itself with comment in line %d", current_line);
1046 /* Is this a fixed-form comment? */
1047 if (gfc_current_form == FORM_FIXED && i == 0
1048 && (c == '*' || c == 'c' || c == 'd'))
1051 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1053 if (!gfc_option.warn_tabs && seen_comment == 0
1054 && current_line != linenum)
1056 linenum = current_line;
1058 "Nonconforming tab character in column 1 of line %d", linenum);
1073 if (maxlen == 0 || preprocessor_flag)
1077 /* Reallocate line buffer to double size to hold the
1079 buflen = buflen * 2;
1080 *pbuf = xrealloc (*pbuf, buflen + 1);
1084 else if (i >= maxlen)
1086 /* Truncate the rest of the line. */
1090 if (c == '\n' || c == EOF)
1096 ungetc ('\n', input);
1100 /* Pad lines to the selected line length in fixed form. */
1101 if (gfc_current_form == FORM_FIXED
1102 && gfc_option.fixed_line_length != 0
1103 && !preprocessor_flag
1106 while (i++ < maxlen)
1118 /* Get a gfc_file structure, initialize it and add it to
1122 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1126 f = gfc_getmem (sizeof (gfc_file));
1128 f->filename = gfc_getmem (strlen (name) + 1);
1129 strcpy (f->filename, name);
1131 f->next = file_head;
1134 f->included_by = current_file;
1135 if (current_file != NULL)
1136 f->inclusion_line = current_file->line;
1138 #ifdef USE_MAPPED_LOCATION
1139 linemap_add (&line_table, reason, false, f->filename, 1);
1145 /* Deal with a line from the C preprocessor. The
1146 initial octothorp has already been seen. */
1149 preprocessor_line (char *c)
1155 int escaped, unescape;
1158 while (*c == ' ' || *c == '\t')
1161 if (*c < '0' || *c > '9')
1166 c = strchr (c, ' ');
1169 /* No file name given. Set new line number. */
1170 current_file->line = line;
1175 while (*c == ' ' || *c == '\t')
1185 /* Make filename end at quote. */
1188 while (*c && ! (! escaped && *c == '"'))
1192 else if (*c == '\\')
1201 /* Preprocessor line has no closing quote. */
1206 /* Undo effects of cpp_quote_string. */
1210 char *d = gfc_getmem (c - filename - unescape);
1226 flag[1] = flag[2] = flag[3] = flag[4] = false;
1230 c = strchr (c, ' ');
1237 if (1 <= i && i <= 4)
1241 /* Interpret flags. */
1243 if (flag[1]) /* Starting new file. */
1245 f = get_file (filename, LC_RENAME);
1246 f->up = current_file;
1250 if (flag[2]) /* Ending current file. */
1252 if (!current_file->up
1253 || strcmp (current_file->up->filename, filename) != 0)
1255 gfc_warning_now ("%s:%d: file %s left but not entered",
1256 current_file->filename, current_file->line,
1259 gfc_free (filename);
1262 current_file = current_file->up;
1265 /* The name of the file can be a temporary file produced by
1266 cpp. Replace the name if it is different. */
1268 if (strcmp (current_file->filename, filename) != 0)
1270 gfc_free (current_file->filename);
1271 current_file->filename = gfc_getmem (strlen (filename) + 1);
1272 strcpy (current_file->filename, filename);
1275 /* Set new line number. */
1276 current_file->line = line;
1278 gfc_free (filename);
1282 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1283 current_file->filename, current_file->line);
1284 current_file->line++;
1288 static try load_file (const char *, bool);
1290 /* include_line()-- Checks a line buffer to see if it is an include
1291 line. If so, we call load_file() recursively to load the included
1292 file. We never return a syntax error because a statement like
1293 "include = 5" is perfectly legal. We return false if no include was
1294 processed or true if we matched an include. */
1297 include_line (char *line)
1299 char quote, *c, *begin, *stop;
1303 if (gfc_option.flag_openmp)
1305 if (gfc_current_form == FORM_FREE)
1307 while (*c == ' ' || *c == '\t')
1309 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1314 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1315 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1320 while (*c == ' ' || *c == '\t')
1323 if (strncasecmp (c, "include", 7))
1327 while (*c == ' ' || *c == '\t')
1330 /* Find filename between quotes. */
1333 if (quote != '"' && quote != '\'')
1338 while (*c != quote && *c != '\0')
1346 while (*c == ' ' || *c == '\t')
1349 if (*c != '\0' && *c != '!')
1352 /* We have an include line at this point. */
1354 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1355 read by anything else. */
1357 load_file (begin, false);
1361 /* Load a file into memory by calling load_line until the file ends. */
1364 load_file (const char *filename, bool initial)
1372 for (f = current_file; f; f = f->up)
1373 if (strcmp (filename, f->filename) == 0)
1375 gfc_error_now ("File '%s' is being included recursively", filename);
1383 input = gfc_src_file;
1384 gfc_src_file = NULL;
1387 input = gfc_open_file (filename);
1390 gfc_error_now ("Can't open file '%s'", filename);
1396 input = gfc_open_included_file (filename, false);
1399 gfc_error_now ("Can't open included file '%s'", filename);
1404 /* Load the file. */
1406 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1407 f->up = current_file;
1409 current_file->line = 1;
1413 if (initial && gfc_src_preprocessor_lines[0])
1415 preprocessor_line (gfc_src_preprocessor_lines[0]);
1416 gfc_free (gfc_src_preprocessor_lines[0]);
1417 gfc_src_preprocessor_lines[0] = NULL;
1418 if (gfc_src_preprocessor_lines[1])
1420 preprocessor_line (gfc_src_preprocessor_lines[1]);
1421 gfc_free (gfc_src_preprocessor_lines[1]);
1422 gfc_src_preprocessor_lines[1] = NULL;
1428 int trunc = load_line (input, &line, &line_len);
1430 len = strlen (line);
1431 if (feof (input) && len == 0)
1434 /* There are three things this line can be: a line of Fortran
1435 source, an include line or a C preprocessor directive. */
1439 preprocessor_line (line);
1443 if (include_line (line))
1445 current_file->line++;
1451 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1453 #ifdef USE_MAPPED_LOCATION
1455 = linemap_line_start (&line_table, current_file->line++, 120);
1457 b->linenum = current_file->line++;
1459 b->file = current_file;
1460 b->truncated = trunc;
1461 strcpy (b->line, line);
1463 if (line_head == NULL)
1466 line_tail->next = b;
1471 /* Release the line buffer allocated in load_line. */
1476 current_file = current_file->up;
1477 #ifdef USE_MAPPED_LOCATION
1478 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1484 /* Open a new file and start scanning from that file. Returns SUCCESS
1485 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1486 it tries to determine the source form from the filename, defaulting
1494 result = load_file (gfc_source_file, true);
1496 gfc_current_locus.lb = line_head;
1497 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1499 #if 0 /* Debugging aid. */
1500 for (; line_head; line_head = line_head->next)
1501 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1502 #ifdef USE_MAPPED_LOCATION
1503 LOCATION_LINE (line_head->location),
1516 unescape_filename (const char *ptr)
1518 const char *p = ptr, *s;
1520 int escaped, unescape = 0;
1522 /* Make filename end at quote. */
1524 while (*p && ! (! escaped && *p == '"'))
1528 else if (*p == '\\')
1539 /* Undo effects of cpp_quote_string. */
1541 d = gfc_getmem (p + 1 - ptr - unescape);
1556 /* For preprocessed files, if the first tokens are of the form # NUM.
1557 handle the directives so we know the original file name. */
1560 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1565 gfc_src_file = gfc_open_file (filename);
1566 if (gfc_src_file == NULL)
1569 c = fgetc (gfc_src_file);
1570 ungetc (c, gfc_src_file);
1576 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1578 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1581 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1582 if (filename == NULL)
1585 c = fgetc (gfc_src_file);
1586 ungetc (c, gfc_src_file);
1592 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1594 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1597 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1598 if (dirname == NULL)
1601 len = strlen (dirname);
1602 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1607 dirname[len - 2] = '\0';
1608 set_src_pwd (dirname);
1610 if (! IS_ABSOLUTE_PATH (filename))
1612 char *p = gfc_getmem (len + strlen (filename));
1614 memcpy (p, dirname, len - 2);
1616 strcpy (p + len - 1, filename);
1617 *canon_source_file = p;