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 The default for free-form is GFC_MAX_LINE, for fixed-form or for
961 unknown form it is 72. Refer to the documentation in gfc_option_t. */
962 if (gfc_current_form == FORM_FREE)
964 if (gfc_option.free_line_length == -1)
965 maxlen = GFC_MAX_LINE;
967 maxlen = gfc_option.free_line_length;
969 else if (gfc_current_form == FORM_FIXED)
971 if (gfc_option.fixed_line_length == -1)
974 maxlen = gfc_option.fixed_line_length;
981 /* Allocate the line buffer, storing its length into buflen. */
985 buflen = GFC_MAX_LINE;
987 *pbuf = gfc_getmem (buflen + 1);
993 preprocessor_flag = 0;
996 /* In order to not truncate preprocessor lines, we have to
997 remember that this is one. */
998 preprocessor_flag = 1;
1009 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1010 if (gfc_current_form == FORM_FREE
1011 && !seen_printable && seen_ampersand)
1015 ("'&' not allowed by itself in line %d", current_line);
1018 ("'&' not allowed by itself in line %d", current_line);
1024 continue; /* Gobble characters. */
1030 /* Ctrl-Z ends the file. */
1031 while (fgetc (input) != EOF);
1035 /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
1039 if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
1042 if (gfc_current_form == FORM_FREE
1043 && c == '!' && !seen_printable && seen_ampersand)
1047 "'&' not allowed by itself with comment in line %d", current_line);
1050 "'&' not allowed by itself with comment in line %d", current_line);
1054 /* Is this a fixed-form comment? */
1055 if (gfc_current_form == FORM_FIXED && i == 0
1056 && (c == '*' || c == 'c' || c == 'd'))
1059 if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
1061 if (!gfc_option.warn_tabs && seen_comment == 0
1062 && current_line != linenum)
1064 linenum = current_line;
1066 "Nonconforming tab character in column 1 of line %d", linenum);
1081 if (maxlen == 0 || preprocessor_flag)
1085 /* Reallocate line buffer to double size to hold the
1087 buflen = buflen * 2;
1088 *pbuf = xrealloc (*pbuf, buflen + 1);
1092 else if (i >= maxlen)
1094 /* Truncate the rest of the line. */
1098 if (c == '\n' || c == EOF)
1104 ungetc ('\n', input);
1108 /* Pad lines to the selected line length in fixed form. */
1109 if (gfc_current_form == FORM_FIXED
1110 && gfc_option.fixed_line_length != 0
1111 && !preprocessor_flag
1114 while (i++ < maxlen)
1126 /* Get a gfc_file structure, initialize it and add it to
1130 get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
1134 f = gfc_getmem (sizeof (gfc_file));
1136 f->filename = gfc_getmem (strlen (name) + 1);
1137 strcpy (f->filename, name);
1139 f->next = file_head;
1142 f->included_by = current_file;
1143 if (current_file != NULL)
1144 f->inclusion_line = current_file->line;
1146 #ifdef USE_MAPPED_LOCATION
1147 linemap_add (&line_table, reason, false, f->filename, 1);
1153 /* Deal with a line from the C preprocessor. The
1154 initial octothorp has already been seen. */
1157 preprocessor_line (char *c)
1163 int escaped, unescape;
1166 while (*c == ' ' || *c == '\t')
1169 if (*c < '0' || *c > '9')
1174 c = strchr (c, ' ');
1177 /* No file name given. Set new line number. */
1178 current_file->line = line;
1183 while (*c == ' ' || *c == '\t')
1193 /* Make filename end at quote. */
1196 while (*c && ! (! escaped && *c == '"'))
1200 else if (*c == '\\')
1209 /* Preprocessor line has no closing quote. */
1214 /* Undo effects of cpp_quote_string. */
1218 char *d = gfc_getmem (c - filename - unescape);
1234 flag[1] = flag[2] = flag[3] = flag[4] = false;
1238 c = strchr (c, ' ');
1245 if (1 <= i && i <= 4)
1249 /* Interpret flags. */
1251 if (flag[1]) /* Starting new file. */
1253 f = get_file (filename, LC_RENAME);
1254 f->up = current_file;
1258 if (flag[2]) /* Ending current file. */
1260 if (!current_file->up
1261 || strcmp (current_file->up->filename, filename) != 0)
1263 gfc_warning_now ("%s:%d: file %s left but not entered",
1264 current_file->filename, current_file->line,
1267 gfc_free (filename);
1270 current_file = current_file->up;
1273 /* The name of the file can be a temporary file produced by
1274 cpp. Replace the name if it is different. */
1276 if (strcmp (current_file->filename, filename) != 0)
1278 gfc_free (current_file->filename);
1279 current_file->filename = gfc_getmem (strlen (filename) + 1);
1280 strcpy (current_file->filename, filename);
1283 /* Set new line number. */
1284 current_file->line = line;
1286 gfc_free (filename);
1290 gfc_warning_now ("%s:%d: Illegal preprocessor directive",
1291 current_file->filename, current_file->line);
1292 current_file->line++;
1296 static try load_file (const char *, bool);
1298 /* include_line()-- Checks a line buffer to see if it is an include
1299 line. If so, we call load_file() recursively to load the included
1300 file. We never return a syntax error because a statement like
1301 "include = 5" is perfectly legal. We return false if no include was
1302 processed or true if we matched an include. */
1305 include_line (char *line)
1307 char quote, *c, *begin, *stop;
1311 if (gfc_option.flag_openmp)
1313 if (gfc_current_form == FORM_FREE)
1315 while (*c == ' ' || *c == '\t')
1317 if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1322 if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
1323 && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
1328 while (*c == ' ' || *c == '\t')
1331 if (strncasecmp (c, "include", 7))
1335 while (*c == ' ' || *c == '\t')
1338 /* Find filename between quotes. */
1341 if (quote != '"' && quote != '\'')
1346 while (*c != quote && *c != '\0')
1354 while (*c == ' ' || *c == '\t')
1357 if (*c != '\0' && *c != '!')
1360 /* We have an include line at this point. */
1362 *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
1363 read by anything else. */
1365 load_file (begin, false);
1369 /* Load a file into memory by calling load_line until the file ends. */
1372 load_file (const char *filename, bool initial)
1380 for (f = current_file; f; f = f->up)
1381 if (strcmp (filename, f->filename) == 0)
1383 gfc_error_now ("File '%s' is being included recursively", filename);
1391 input = gfc_src_file;
1392 gfc_src_file = NULL;
1395 input = gfc_open_file (filename);
1398 gfc_error_now ("Can't open file '%s'", filename);
1404 input = gfc_open_included_file (filename, false);
1407 gfc_error_now ("Can't open included file '%s'", filename);
1412 /* Load the file. */
1414 f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
1415 f->up = current_file;
1417 current_file->line = 1;
1421 if (initial && gfc_src_preprocessor_lines[0])
1423 preprocessor_line (gfc_src_preprocessor_lines[0]);
1424 gfc_free (gfc_src_preprocessor_lines[0]);
1425 gfc_src_preprocessor_lines[0] = NULL;
1426 if (gfc_src_preprocessor_lines[1])
1428 preprocessor_line (gfc_src_preprocessor_lines[1]);
1429 gfc_free (gfc_src_preprocessor_lines[1]);
1430 gfc_src_preprocessor_lines[1] = NULL;
1436 int trunc = load_line (input, &line, &line_len);
1438 len = strlen (line);
1439 if (feof (input) && len == 0)
1442 /* There are three things this line can be: a line of Fortran
1443 source, an include line or a C preprocessor directive. */
1447 preprocessor_line (line);
1451 if (include_line (line))
1453 current_file->line++;
1459 b = gfc_getmem (gfc_linebuf_header_size + len + 1);
1461 #ifdef USE_MAPPED_LOCATION
1463 = linemap_line_start (&line_table, current_file->line++, 120);
1465 b->linenum = current_file->line++;
1467 b->file = current_file;
1468 b->truncated = trunc;
1469 strcpy (b->line, line);
1471 if (line_head == NULL)
1474 line_tail->next = b;
1479 /* Release the line buffer allocated in load_line. */
1484 current_file = current_file->up;
1485 #ifdef USE_MAPPED_LOCATION
1486 linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
1492 /* Open a new file and start scanning from that file. Returns SUCCESS
1493 if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
1494 it tries to determine the source form from the filename, defaulting
1502 result = load_file (gfc_source_file, true);
1504 gfc_current_locus.lb = line_head;
1505 gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
1507 #if 0 /* Debugging aid. */
1508 for (; line_head; line_head = line_head->next)
1509 gfc_status ("%s:%3d %s\n", line_head->file->filename,
1510 #ifdef USE_MAPPED_LOCATION
1511 LOCATION_LINE (line_head->location),
1524 unescape_filename (const char *ptr)
1526 const char *p = ptr, *s;
1528 int escaped, unescape = 0;
1530 /* Make filename end at quote. */
1532 while (*p && ! (! escaped && *p == '"'))
1536 else if (*p == '\\')
1547 /* Undo effects of cpp_quote_string. */
1549 d = gfc_getmem (p + 1 - ptr - unescape);
1564 /* For preprocessed files, if the first tokens are of the form # NUM.
1565 handle the directives so we know the original file name. */
1568 gfc_read_orig_filename (const char *filename, const char **canon_source_file)
1573 gfc_src_file = gfc_open_file (filename);
1574 if (gfc_src_file == NULL)
1577 c = fgetc (gfc_src_file);
1578 ungetc (c, gfc_src_file);
1584 load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
1586 if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
1589 filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
1590 if (filename == NULL)
1593 c = fgetc (gfc_src_file);
1594 ungetc (c, gfc_src_file);
1600 load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
1602 if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
1605 dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
1606 if (dirname == NULL)
1609 len = strlen (dirname);
1610 if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
1615 dirname[len - 2] = '\0';
1616 set_src_pwd (dirname);
1618 if (! IS_ABSOLUTE_PATH (filename))
1620 char *p = gfc_getmem (len + strlen (filename));
1622 memcpy (p, dirname, len - 2);
1624 strcpy (p + len - 1, filename);
1625 *canon_source_file = p;