/* Character scanner.
- Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
-This file is part of GNU G95.
+This file is part of GCC.
-GNU G95 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
-GNU G95 is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
You should have received a copy of the GNU General Public License
-along with GNU G95; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+along with GCC; see the file COPYING. If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
/* Set of subroutines to (ultimately) return the next character to the
various matching subroutines. This file's job is to read files and
new characters and do a lot of jumping backwards. */
#include "config.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <strings.h>
-
+#include "system.h"
#include "gfortran.h"
/* Structure for holding module and include file search path. */
/* List of include file search directories. */
static gfc_directorylist *include_dirs;
-static gfc_file *first_file, *first_duplicated_file;
-static int continue_flag, end_flag;
+static gfc_file *file_head, *current_file;
-gfc_file *gfc_current_file;
+static int continue_flag, end_flag;
+gfc_source_form gfc_current_form;
+static gfc_linebuf *line_head, *line_tail;
+
+locus gfc_current_locus;
+char *gfc_source_file;
+
/* Main scanner initialization. */
void
gfc_scanner_init_1 (void)
{
+ file_head = NULL;
+ line_head = NULL;
+ line_tail = NULL;
- gfc_current_file = NULL;
- first_file = NULL;
- first_duplicated_file = NULL;
end_flag = 0;
}
void
gfc_scanner_done_1 (void)
{
+ gfc_linebuf *lb;
+ gfc_file *f;
- linebuf *lp, *lp2;
- gfc_file *fp, *fp2;
-
- for (fp = first_file; fp; fp = fp2)
+ while(line_head != NULL)
{
-
- if (fp->start != NULL)
- {
- /* Free linebuf blocks */
- for (fp2 = fp->next; fp2; fp2 = fp2->next)
- if (fp->start == fp2->start)
- fp2->start = NULL;
-
- for (lp = fp->start; lp; lp = lp2)
- {
- lp2 = lp->next;
- gfc_free (lp);
- }
- }
-
- fp2 = fp->next;
- gfc_free (fp);
+ lb = line_head->next;
+ gfc_free(line_head);
+ line_head = lb;
}
-
- for (fp = first_duplicated_file; fp; fp = fp2)
+
+ while(file_head != NULL)
{
- fp2 = fp->next;
- gfc_free (fp);
+ f = file_head->next;
+ gfc_free(file_head->filename);
+ gfc_free(file_head);
+ file_head = f;
}
+
}
}
}
-
/* Opens file for reading, searching through the include directories
given if necessary. */
return NULL;
}
-
-/* Return a pointer to the current locus. */
-
-locus *
-gfc_current_locus (void)
-{
-
- if (gfc_current_file == NULL)
- return NULL;
- return &gfc_current_file->loc;
-}
-
-
-/* Let a caller move the current read pointer (backwards). */
-
-void
-gfc_set_locus (locus * lp)
-{
-
- gfc_current_file->loc = *lp;
-}
-
-
/* Test to see if we're at the end of the main source file. */
int
if (gfc_at_end ())
return 1;
- if (gfc_current_file->start->lines == 0)
+ if (line_head == NULL)
return 1; /* Null file */
- if (gfc_current_file->loc.lp == NULL)
+ if (gfc_current_locus.lb == NULL)
return 1;
return 0;
int
gfc_at_bol (void)
{
- int i;
-
if (gfc_at_eof ())
return 1;
- i = gfc_current_file->loc.line;
-
- return gfc_current_file->loc.nextc == gfc_current_file->loc.lp->line[i];
+ return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
}
if (gfc_at_eof ())
return 1;
- return *gfc_current_file->loc.nextc == '\0';
+ return (*gfc_current_locus.nextc == '\0');
}
void
gfc_advance_line (void)
{
- locus *locp;
- linebuf *lp;
-
if (gfc_at_end ())
return;
- locp = &gfc_current_file->loc;
- lp = locp->lp;
- if (lp == NULL)
- return;
-
- if (++locp->line >= lp->lines)
+ if (gfc_current_locus.lb == NULL)
{
- locp->lp = lp = lp->next;
- if (lp == NULL)
- return; /* End of this file */
+ end_flag = 1;
+ return;
+ }
- locp->line = 0;
- }
+ gfc_current_locus.lb = gfc_current_locus.lb->next;
- locp->nextc = lp->line[locp->line];
+ if (gfc_current_locus.lb != NULL)
+ gfc_current_locus.nextc = gfc_current_locus.lb->line;
+ else
+ {
+ gfc_current_locus.nextc = NULL;
+ end_flag = 1;
+ }
}
static int
next_char (void)
{
- locus *locp;
int c;
-
- /* End the current include level, but not if we're in the middle
- of processing a continuation. */
- if (gfc_at_eof ())
- {
- if (continue_flag != 0 || gfc_at_end ())
- return '\n';
-
- if (gfc_current_file->included_by == NULL)
- end_flag = 1;
-
- return '\n';
- }
-
- locp = &gfc_current_file->loc;
- if (locp->nextc == NULL)
+
+ if (gfc_current_locus.nextc == NULL)
return '\n';
- c = *locp->nextc++;
+ c = *gfc_current_locus.nextc++;
if (c == '\0')
{
- locp->nextc--; /* Stay stuck on this line */
+ gfc_current_locus.nextc--; /* Remain on this line. */
c = '\n';
}
return c;
}
-
-/* Checks the current line buffer to see if it is an include line. If
- so, we load the new file and prepare to read from it. Include
- lines happen at a lower level than regular parsing because the
- string-matching subroutine is far simpler than the normal one.
-
- We never return a syntax error because a statement like "include = 5"
- is perfectly legal. We return zero if no include was processed or
- nonzero if we matched an include. */
-
-int
-gfc_check_include (void)
-{
- char c, quote, path[PATH_MAX + 1];
- const char *include;
- locus start;
- int i;
-
- include = "include";
-
- start = *gfc_current_locus ();
- gfc_gobble_whitespace ();
-
- /* Match the 'include' */
- while (*include != '\0')
- if (*include++ != gfc_next_char ())
- goto no_include;
-
- gfc_gobble_whitespace ();
-
- quote = next_char ();
- if (quote != '"' && quote != '\'')
- goto no_include;
-
- /* Copy the filename */
- for (i = 0;;)
- {
- c = next_char ();
- if (c == '\n')
- goto no_include; /* No close quote */
- if (c == quote)
- break;
-
- /* This shouldn't happen-- PATH_MAX should be way longer than the
- max line length. */
-
- if (i >= PATH_MAX)
- gfc_internal_error ("Pathname of include file is too long at %C");
-
- path[i++] = c;
- }
-
- path[i] = '\0';
- if (i == 0)
- goto no_include; /* No filename! */
-
- /* At this point, we've got a filename to be included. The rest
- of the include line is ignored */
-
- gfc_new_file (path, gfc_current_file->form);
- return 1;
-
-no_include:
- gfc_set_locus (&start);
- return 0;
-}
-
-
/* Skip a comment. When we come here the parse pointer is positioned
immediately after the comment character. If we ever implement
compiler directives withing comments, here is where we parse the
for (;;)
{
- start = *gfc_current_locus ();
+ start = gfc_current_locus;
if (gfc_at_eof ())
break;
break;
}
- gfc_set_locus (&start);
+ gfc_current_locus = start;
}
/* Skip comment lines in fixed source mode. We have the same rules as
in skip_free_comment(), except that we can have a 'c', 'C' or '*'
- in column 1. and a '!' cannot be in* column 6. */
+ in column 1, and a '!' cannot be in column 6. */
static void
skip_fixed_comments (void)
for (;;)
{
- start = *gfc_current_locus ();
+ start = gfc_current_locus;
if (gfc_at_eof ())
break;
break;
}
- gfc_set_locus (&start);
+ gfc_current_locus = start;
}
gfc_skip_comments (void)
{
- if (!gfc_at_bol () || gfc_current_file->form == FORM_FREE)
+ if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
skip_free_comments ();
else
skip_fixed_comments ();
if (gfc_at_end ())
return c;
- if (gfc_current_file->form == FORM_FREE)
+ if (gfc_current_form == FORM_FREE)
{
if (!in_string && c == '!')
}
while (c != '\n');
+ /* Avoid truncation warnings for comment ending lines. */
+ gfc_current_locus.lb->truncated = 0;
+
goto done;
}
goto done;
/* If the next nonblank character is a ! or \n, we've got a
- continuation line. */
- old_loc = gfc_current_file->loc;
+ continuation line. */
+ old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
if (in_string && c != '\n')
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
c = '&';
goto done;
}
if (c != '!' && c != '\n')
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
c = '&';
goto done;
}
reading starts at the next character, otherwise we must back
up to where the whitespace started and resume from there. */
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
c = next_char ();
if (c != '&')
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
}
else
c = next_char ();
}
while (c != '\n');
+
+ /* Avoid truncation warnings for comment ending lines. */
+ gfc_current_locus.lb->truncated = 0;
}
if (c != '\n')
goto done;
continue_flag = 1;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_advance_line ();
gfc_skip_comments ();
not_continuation:
c = '\n';
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
done:
continue_flag = 0;
{
c = gfc_next_char_literal (0);
}
- while (gfc_current_file->form == FORM_FIXED && gfc_is_whitespace (c));
+ while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
return TOLOWER (c);
}
locus old_loc;
int c;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return c;
}
if (c == delim)
break;
if (c == '\n')
- goto done;
+ return;
if (c == '\\')
{
c = next_char ();
if (c == '\n')
- goto done;
+ return;
}
}
if (gfc_at_eof ())
break;
}
-
-done:
- if (c == '\n')
- gfc_advance_line ();
}
do
{
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char_literal (0);
}
while (gfc_is_whitespace (c));
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
}
-/* Load a single line into the buffer. We truncate lines that are too
- long. In fixed mode, we expand a tab that occurs within the
- statement label region to expand to spaces that leave the next
- character in the source region. */
+/* Load a single line into pbuf.
-static void
-load_line (FILE * input, gfc_source_form form, char *buffer,
- char *filename, int linenum)
+ If pbuf points to a NULL pointer, it is allocated.
+ We truncate lines that are too long, unless we're dealing with
+ preprocessor lines or if the option -ffixed-line-length-none is set,
+ in which case we reallocate the buffer to fit the entire line, if
+ need be.
+ In fixed mode, we expand a tab that occurs within the statement
+ label region to expand to spaces that leave the next character in
+ the source region.
+ load_line returns wether the line was truncated. */
+
+static int
+load_line (FILE * input, char **pbuf)
{
- int c, maxlen, i, trunc_flag;
+ int c, maxlen, i, preprocessor_flag;
+ int trunc_flag = 0;
+ static int buflen = 0;
+ char *buffer;
+
+ /* Determine the maximum allowed line length. */
+ if (gfc_current_form == FORM_FREE)
+ maxlen = GFC_MAX_LINE;
+ else
+ maxlen = gfc_option.fixed_line_length;
- maxlen = (form == FORM_FREE) ? 132 : gfc_option.fixed_line_length;
+ if (*pbuf == NULL)
+ {
+ /* Allocate the line buffer, storing its length into buflen. */
+ if (maxlen > 0)
+ buflen = maxlen;
+ else
+ buflen = GFC_MAX_LINE;
+
+ *pbuf = gfc_getmem (buflen + 1);
+ }
i = 0;
+ buffer = *pbuf;
+
+ preprocessor_flag = 0;
+ c = fgetc (input);
+ if (c == '#')
+ /* In order to not truncate preprocessor lines, we have to
+ remember that this is one. */
+ preprocessor_flag = 1;
+ ungetc (c, input);
for (;;)
{
break;
if (c == '\r')
- continue; /* Gobble characters */
+ continue; /* Gobble characters. */
if (c == '\0')
continue;
- if (form == FORM_FIXED && c == '\t' && i <= 6)
- { /* Tab expandsion */
+ if (c == '\032')
+ {
+ /* Ctrl-Z ends the file. */
+ while (fgetc (input) != EOF);
+ break;
+ }
+
+ if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
+ { /* Tab expansion. */
while (i <= 6)
{
*buffer++ = ' ';
*buffer++ = c;
i++;
- if (i >= maxlen)
- { /* Truncate the rest of the line */
- trunc_flag = 1;
-
+ if (i >= buflen && (maxlen == 0 || preprocessor_flag))
+ {
+ /* Reallocate line buffer to double size to hold the
+ overlong line. */
+ buflen = buflen * 2;
+ *pbuf = xrealloc (*pbuf, buflen);
+ buffer = (*pbuf)+i;
+ }
+ else if (i >= buflen)
+ {
+ /* Truncate the rest of the line. */
for (;;)
{
c = fgetc (input);
if (c == '\n' || c == EOF)
break;
- if (gfc_option.warn_line_truncation
- && trunc_flag
- && !gfc_is_whitespace (c))
- {
- gfc_warning_now ("Line %d of %s is being truncated",
- linenum, filename);
- trunc_flag = 0;
- }
+ trunc_flag = 1;
}
ungetc ('\n', input);
}
}
+ /* Pad lines to the selected line length in fixed form. */
+ if (gfc_current_form == FORM_FIXED
+ && gfc_option.fixed_line_length > 0
+ && !preprocessor_flag
+ && c != EOF)
+ while (i++ < buflen)
+ *buffer++ = ' ';
+
*buffer = '\0';
+
+ return trunc_flag;
}
-/* Load a file into memory by calling load_line until the file ends. */
+/* Get a gfc_file structure, initialize it and add it to
+ the file stack. */
+
+static gfc_file *
+get_file (char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
+{
+ gfc_file *f;
+
+ f = gfc_getmem (sizeof (gfc_file));
+
+ f->filename = gfc_getmem (strlen (name) + 1);
+ strcpy (f->filename, name);
+
+ f->next = file_head;
+ file_head = f;
+
+ f->included_by = current_file;
+ if (current_file != NULL)
+ f->inclusion_line = current_file->line;
+
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (&line_table, reason, false, f->filename, 1);
+#endif
+
+ return f;
+}
+
+/* Deal with a line from the C preprocessor. The
+ initial octothorp has already been seen. */
static void
-load_file (FILE * input, gfc_file * fp)
+preprocessor_line (char *c)
{
- char *linep, line[GFC_MAX_LINE + 1];
- int len, linenum;
- linebuf *lp;
+ bool flag[5];
+ int i, line;
+ char *filename;
+ gfc_file *f;
+ int escaped;
- fp->start = lp = gfc_getmem (sizeof (linebuf));
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
- linenum = 1;
- lp->lines = 0;
- lp->start_line = 1;
- lp->next = NULL;
+ if (*c < '0' || *c > '9')
+ goto bad_cpp_line;
- linep = (char *) (lp + 1);
+ line = atoi (c);
+
+ /* Set new line number. */
+ current_file->line = line;
+
+ c = strchr (c, ' ');
+ if (c == NULL)
+ /* No file name given. */
+ return;
+
+
+
+ /* Skip spaces. */
+ while (*c == ' ' || *c == '\t')
+ c++;
+
+ /* Skip quote. */
+ if (*c != '"')
+ goto bad_cpp_line;
+ ++c;
+
+ filename = c;
+
+ /* Make filename end at quote. */
+ escaped = false;
+ while (*c && ! (! escaped && *c == '"'))
+ {
+ if (escaped)
+ escaped = false;
+ else
+ escaped = *c == '\\';
+ ++c;
+ }
+
+ if (! *c)
+ /* Preprocessor line has no closing quote. */
+ goto bad_cpp_line;
+
+ *c++ = '\0';
+
+
+
+ /* Get flags. */
+
+ flag[1] = flag[2] = flag[3] = flag[4] = flag[5] = false;
- /* Load the file. */
for (;;)
{
- load_line (input, fp->form, line, fp->filename, linenum);
- linenum++;
+ c = strchr (c, ' ');
+ if (c == NULL)
+ break;
- len = strlen (line);
+ c++;
+ i = atoi (c);
+
+ if (1 <= i && i <= 4)
+ flag[i] = true;
+ }
+
+ /* Interpret flags. */
+
+ if (flag[1] || flag[3]) /* Starting new file. */
+ {
+ f = get_file (filename, LC_RENAME);
+ f->up = current_file;
+ current_file = f;
+ }
+
+ if (flag[2]) /* Ending current file. */
+ {
+ current_file = current_file->up;
+ }
+
+ /* The name of the file can be a temporary file produced by
+ cpp. Replace the name if it is different. */
+
+ if (strcmp (current_file->filename, filename) != 0)
+ {
+ gfc_free (current_file->filename);
+ current_file->filename = gfc_getmem (strlen (filename) + 1);
+ strcpy (current_file->filename, filename);
+ }
+ return;
+
+ bad_cpp_line:
+ gfc_warning_now ("%s:%d: Illegal preprocessor directive",
+ current_file->filename, current_file->line);
+ current_file->line++;
+}
+
+
+static try load_file (char *, bool);
+
+/* include_line()-- Checks a line buffer to see if it is an include
+ line. If so, we call load_file() recursively to load the included
+ file. We never return a syntax error because a statement like
+ "include = 5" is perfectly legal. We return false if no include was
+ processed or true if we matched an include. */
+
+static bool
+include_line (char *line)
+{
+ char quote, *c, *begin, *stop;
+
+ c = line;
+ while (*c == ' ' || *c == '\t')
+ c++;
+
+ if (strncasecmp (c, "include", 7))
+ return false;
+
+ c += 7;
+ while (*c == ' ' || *c == '\t')
+ c++;
+
+ /* Find filename between quotes. */
+
+ quote = *c++;
+ if (quote != '"' && quote != '\'')
+ return false;
+
+ begin = c;
+
+ while (*c != quote && *c != '\0')
+ c++;
+
+ if (*c == '\0')
+ return false;
+
+ stop = c++;
+
+ while (*c == ' ' || *c == '\t')
+ c++;
+
+ if (*c != '\0' && *c != '!')
+ return false;
+
+ /* We have an include line at this point. */
+
+ *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
+ read by anything else. */
+
+ load_file (begin, false);
+ return true;
+}
+
+/* Load a file into memory by calling load_line until the file ends. */
+
+static try
+load_file (char *filename, bool initial)
+{
+ char *line;
+ gfc_linebuf *b;
+ gfc_file *f;
+ FILE *input;
+ int len;
+
+ for (f = current_file; f; f = f->up)
+ if (strcmp (filename, f->filename) == 0)
+ {
+ gfc_error_now ("File '%s' is being included recursively", filename);
+ return FAILURE;
+ }
+
+ if (initial)
+ {
+ input = gfc_open_file (filename);
+ if (input == NULL)
+ {
+ gfc_error_now ("Can't open file '%s'", filename);
+ return FAILURE;
+ }
+ }
+ else
+ {
+ input = gfc_open_included_file (filename);
+ if (input == NULL)
+ {
+ gfc_error_now ("Can't open included file '%s'", filename);
+ return FAILURE;
+ }
+ }
+
+ /* Load the file. */
+
+ f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
+ f->up = current_file;
+ current_file = f;
+ current_file->line = 1;
+ line = NULL;
+
+ for (;;)
+ {
+ int trunc = load_line (input, &line);
+
+ len = strlen (line);
if (feof (input) && len == 0)
break;
- /* See if we need another linebuf. */
- if (((char *) &lp->line[lp->lines + 2]) > linep - len - 1)
- {
- lp->next = gfc_getmem (sizeof (linebuf));
+ /* There are three things this line can be: a line of Fortran
+ source, an include line or a C preprocessor directive. */
- lp->next->start_line = lp->start_line + lp->lines;
- lp = lp->next;
- lp->lines = 0;
+ if (line[0] == '#')
+ {
+ preprocessor_line (line);
+ continue;
+ }
- linep = (char *) (lp + 1);
+ if (include_line (line))
+ {
+ current_file->line++;
+ continue;
}
- linep = linep - len - 1;
- lp->line[lp->lines++] = linep;
- strcpy (linep, line);
+ /* Add line. */
+
+ b = gfc_getmem (gfc_linebuf_header_size + len + 1);
+
+#ifdef USE_MAPPED_LOCATION
+ b->location
+ = linemap_line_start (&line_table, current_file->line++, 120);
+#else
+ b->linenum = current_file->line++;
+#endif
+ b->file = current_file;
+ b->truncated = trunc;
+ strcpy (b->line, line);
+
+ if (line_head == NULL)
+ line_head = b;
+ else
+ line_tail->next = b;
+
+ line_tail = b;
}
+
+ /* Release the line buffer allocated in load_line. */
+ gfc_free (line);
+
+ fclose (input);
+
+ current_file = current_file->up;
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
+#endif
+ return SUCCESS;
}
/* Determine the source form from the filename extension. We assume
- case insensitivity. */
+ case insensitivity. */
static gfc_source_form
form_from_filename (const char *filename)
}
-/* Open a new file and start scanning from that file. Every new file
- gets a gfc_file node, even if it is a duplicate file. Returns SUCCESS
- if everything went OK, FAILURE otherwise. */
+/* Open a new file and start scanning from that file. Returns SUCCESS
+ if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
+ it tries to determine the source form from the filename, defaulting
+ to free form. */
try
gfc_new_file (const char *filename, gfc_source_form form)
{
- gfc_file *fp, *fp2;
- FILE *input;
- int len;
+ try result;
- len = strlen (filename);
- if (len > PATH_MAX)
+ if (filename != NULL)
{
- gfc_error_now ("Filename '%s' is too long- ignoring it", filename);
- return FAILURE;
+ gfc_source_file = gfc_getmem (strlen (filename) + 1);
+ strcpy (gfc_source_file, filename);
}
-
- fp = gfc_getmem (sizeof (gfc_file));
-
- /* Make sure this file isn't being included recursively. */
- for (fp2 = gfc_current_file; fp2; fp2 = fp2->included_by)
- if (strcmp (filename, fp2->filename) == 0)
- {
- gfc_error_now ("Recursive inclusion of file '%s' at %C- ignoring it",
- filename);
- gfc_free (fp);
- return FAILURE;
- }
-
- /* See if the file has already been included. */
- for (fp2 = first_file; fp2; fp2 = fp2->next)
- if (strcmp (filename, fp2->filename) == 0)
- {
- *fp = *fp2;
- fp->next = first_duplicated_file;
- first_duplicated_file = fp;
- goto init_fp;
- }
-
- strcpy (fp->filename, filename);
-
- if (gfc_current_file == NULL)
- input = gfc_open_file (filename);
else
- input = gfc_open_included_file (filename);
-
- if (input == NULL)
- {
- if (gfc_current_file == NULL)
- gfc_error_now ("Can't open file '%s'", filename);
- else
- gfc_error_now ("Can't open file '%s' included at %C", filename);
-
- gfc_free (fp);
- return FAILURE;
- }
+ gfc_source_file = NULL;
/* Decide which form the file will be read in as. */
+
if (form != FORM_UNKNOWN)
- fp->form = form;
+ gfc_current_form = form;
else
{
- fp->form = form_from_filename (filename);
+ gfc_current_form = form_from_filename (filename);
- if (fp->form == FORM_UNKNOWN)
+ if (gfc_current_form == FORM_UNKNOWN)
{
- fp->form = FORM_FREE;
- gfc_warning_now ("Reading file %s as free form", filename);
+ gfc_current_form = FORM_FREE;
+ gfc_warning_now ("Reading file '%s' as free form.",
+ (filename[0] == '\0') ? "<stdin>" : filename);
}
}
- fp->next = first_file;
- first_file = fp;
+ result = load_file (gfc_source_file, true);
- load_file (input, fp);
- fclose (input);
+ gfc_current_locus.lb = line_head;
+ gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
-init_fp:
- fp->included_by = gfc_current_file;
- gfc_current_file = fp;
+#if 0 /* Debugging aid. */
+ for (; line_head; line_head = line_head->next)
+ gfc_status ("%s:%3d %s\n", line_head->file->filename,
+#ifdef USE_MAPPED_LOCATION
+ LOCATION_LINE (line_head->location),
+#else
+ line_head->linenum,
+#endif
+ line_head->line);
- fp->loc.line = 0;
- fp->loc.lp = fp->start;
- fp->loc.nextc = fp->start->line[0];
- fp->loc.file = fp;
+ exit (0);
+#endif
- return SUCCESS;
+ return result;
}
git://gcc.gnu.org / gcc.git / blobdiff