X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Ffortran%2Fscanner.c;h=c226baee9667780f71250a317751d2c46bf949f3;hp=92ee3661480a699a4f2c0150b1f96a9eb01c0f80;hb=857616f6172b13aec886bb0b3e2e166f5e75622b;hpb=40da2b01e4cc57a1cf890af8966a9fe49b748473
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 92ee3661480..c226baee966 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1,13 +1,13 @@
/* Character scanner.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
- Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+ 2010 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
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
+Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -16,9 +16,8 @@ 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 GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA. */
+along with GCC; see the file COPYING3. If not see
+. */
/* Set of subroutines to (ultimately) return the next character to the
various matching subroutines. This file's job is to read files and
@@ -45,24 +44,29 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "config.h"
#include "system.h"
#include "gfortran.h"
-#include "toplev.h"
+#include "toplev.h" /* For set_src_pwd. */
+#include "debug.h"
+#include "flags.h"
+#include "cpp.h"
/* Structure for holding module and include file search path. */
typedef struct gfc_directorylist
{
char *path;
+ bool use_for_modules;
struct gfc_directorylist *next;
}
gfc_directorylist;
/* List of include file search directories. */
-static gfc_directorylist *include_dirs;
+static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
static gfc_file *file_head, *current_file;
-static int continue_flag, end_flag, openmp_flag;
+static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
static int continue_count, continue_line;
static locus openmp_locus;
+static locus gcc_attribute_locus;
gfc_source_form gfc_current_form;
static gfc_linebuf *line_head, *line_tail;
@@ -70,9 +74,192 @@ static gfc_linebuf *line_head, *line_tail;
locus gfc_current_locus;
const char *gfc_source_file;
static FILE *gfc_src_file;
-static char *gfc_src_preprocessor_lines[2];
+static gfc_char_t *gfc_src_preprocessor_lines[2];
+
+static struct gfc_file_change
+{
+ const char *filename;
+ gfc_linebuf *lb;
+ int line;
+} *file_changes;
+size_t file_changes_cur, file_changes_count;
+size_t file_changes_allocated;
+
+
+/* Functions dealing with our wide characters (gfc_char_t) and
+ sequences of such characters. */
+
+int
+gfc_wide_fits_in_byte (gfc_char_t c)
+{
+ return (c <= UCHAR_MAX);
+}
+
+static inline int
+wide_is_ascii (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
+}
+
+int
+gfc_wide_is_printable (gfc_char_t c)
+{
+ return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
+}
+
+gfc_char_t
+gfc_wide_tolower (gfc_char_t c)
+{
+ return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
+}
+
+gfc_char_t
+gfc_wide_toupper (gfc_char_t c)
+{
+ return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c) : c);
+}
+
+int
+gfc_wide_is_digit (gfc_char_t c)
+{
+ return (c >= '0' && c <= '9');
+}
+
+static inline int
+wide_atoi (gfc_char_t *c)
+{
+#define MAX_DIGITS 20
+ char buf[MAX_DIGITS+1];
+ int i = 0;
+
+ while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
+ buf[i++] = *c++;
+ buf[i] = '\0';
+ return atoi (buf);
+}
+
+size_t
+gfc_wide_strlen (const gfc_char_t *str)
+{
+ size_t i;
+
+ for (i = 0; str[i]; i++)
+ ;
+
+ return i;
+}
+
+gfc_char_t *
+gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len)
+{
+ size_t i;
+
+ for (i = 0; i < len; i++)
+ b[i] = c;
+
+ return b;
+}
+
+static gfc_char_t *
+wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
+{
+ gfc_char_t *d;
+
+ for (d = dest; (*d = *src) != '\0'; ++src, ++d)
+ ;
+
+ return dest;
+}
+
+static gfc_char_t *
+wide_strchr (const gfc_char_t *s, gfc_char_t c)
+{
+ do {
+ if (*s == c)
+ {
+ return CONST_CAST(gfc_char_t *, s);
+ }
+ } while (*s++);
+ return 0;
+}
+
+char *
+gfc_widechar_to_char (const gfc_char_t *s, int length)
+{
+ size_t len, i;
+ char *res;
+
+ if (s == NULL)
+ return NULL;
+
+ /* Passing a negative length is used to indicate that length should be
+ calculated using gfc_wide_strlen(). */
+ len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s));
+ res = XNEWVEC (char, len + 1);
+
+ for (i = 0; i < len; i++)
+ {
+ gcc_assert (gfc_wide_fits_in_byte (s[i]));
+ res[i] = (unsigned char) s[i];
+ }
+
+ res[len] = '\0';
+ return res;
+}
+
+gfc_char_t *
+gfc_char_to_widechar (const char *s)
+{
+ size_t len, i;
+ gfc_char_t *res;
+
+ if (s == NULL)
+ return NULL;
+
+ len = strlen (s);
+ res = gfc_get_wide_string (len + 1);
+
+ for (i = 0; i < len; i++)
+ res[i] = (unsigned char) s[i];
+
+ res[len] = '\0';
+ return res;
+}
+
+static int
+wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = *s1++;
+ c2 = *s2++;
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
+
+int
+gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+ gfc_char_t c1, c2;
+
+ while (n-- > 0)
+ {
+ c1 = gfc_wide_tolower (*s1++);
+ c2 = TOLOWER (*s2++);
+ if (c1 != c2)
+ return (c1 > c2 ? 1 : -1);
+ if (c1 == '\0')
+ return 0;
+ }
+ return 0;
+}
-extern int pedantic;
/* Main scanner initialization. */
@@ -112,44 +299,67 @@ gfc_scanner_done_1 (void)
gfc_free(file_head);
file_head = f;
}
-
}
/* Adds path to the list pointed to by list. */
-void
-gfc_add_include_path (const char *path)
+static void
+add_path_to_list (gfc_directorylist **list, const char *path,
+ bool use_for_modules, bool head)
{
gfc_directorylist *dir;
const char *p;
p = path;
- while (*p == ' ' || *p == '\t') /* someone might do 'gfortran "-I include"' */
+ while (*p == ' ' || *p == '\t') /* someone might do "-I include" */
if (*p++ == '\0')
return;
- dir = include_dirs;
- if (!dir)
+ if (head || *list == NULL)
{
- dir = include_dirs = gfc_getmem (sizeof (gfc_directorylist));
+ dir = XCNEW (gfc_directorylist);
+ if (!head)
+ *list = dir;
}
else
{
+ dir = *list;
while (dir->next)
dir = dir->next;
- dir->next = gfc_getmem (sizeof (gfc_directorylist));
+ dir->next = XCNEW (gfc_directorylist);
dir = dir->next;
}
- dir->next = NULL;
- dir->path = gfc_getmem (strlen (p) + 2);
+ dir->next = head ? *list : NULL;
+ if (head)
+ *list = dir;
+ dir->use_for_modules = use_for_modules;
+ dir->path = XCNEWVEC (char, strlen (p) + 2);
strcpy (dir->path, p);
strcat (dir->path, "/"); /* make '/' last character */
}
+void
+gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir)
+{
+ add_path_to_list (&include_dirs, path, use_for_modules, file_dir);
+
+ /* For '#include "..."' these directories are automatically searched. */
+ if (!file_dir)
+ gfc_cpp_add_include_path (xstrdup(path), true);
+}
+
+
+void
+gfc_add_intrinsic_modules_path (const char *path)
+{
+ add_path_to_list (&intrinsic_modules_dirs, path, true, false);
+}
+
+
/* Release resources allocated for options. */
void
@@ -157,7 +367,6 @@ gfc_release_include_path (void)
{
gfc_directorylist *p;
- gfc_free (gfc_option.module_dir);
while (include_dirs != NULL)
{
p = include_dirs;
@@ -165,46 +374,96 @@ gfc_release_include_path (void)
gfc_free (p->path);
gfc_free (p);
}
+
+ while (intrinsic_modules_dirs != NULL)
+ {
+ p = intrinsic_modules_dirs;
+ intrinsic_modules_dirs = intrinsic_modules_dirs->next;
+ gfc_free (p->path);
+ gfc_free (p);
+ }
+
+ gfc_free (gfc_option.module_dir);
}
-/* Opens file for reading, searching through the include directories
- given if necessary. If the include_cwd argument is true, we try
- to open the file in the current directory first. */
-FILE *
-gfc_open_included_file (const char *name, const bool include_cwd)
+static FILE *
+open_included_file (const char *name, gfc_directorylist *list,
+ bool module, bool system)
{
char *fullname;
gfc_directorylist *p;
FILE *f;
- if (include_cwd)
+ for (p = list; p; p = p->next)
{
- f = gfc_open_file (name);
- if (f != NULL)
- return f;
- }
+ if (module && !p->use_for_modules)
+ continue;
- for (p = include_dirs; p; p = p->next)
- {
fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
strcpy (fullname, p->path);
strcat (fullname, name);
f = gfc_open_file (fullname);
if (f != NULL)
- return f;
+ {
+ if (gfc_cpp_makedep ())
+ gfc_cpp_add_dep (fullname, system);
+
+ return f;
+ }
}
return NULL;
}
+
+/* Opens file for reading, searching through the include directories
+ given if necessary. If the include_cwd argument is true, we try
+ to open the file in the current directory first. */
+
+FILE *
+gfc_open_included_file (const char *name, bool include_cwd, bool module)
+{
+ FILE *f = NULL;
+
+ if (IS_ABSOLUTE_PATH (name) || include_cwd)
+ {
+ f = gfc_open_file (name);
+ if (f && gfc_cpp_makedep ())
+ gfc_cpp_add_dep (name, false);
+ }
+
+ if (!f)
+ f = open_included_file (name, include_dirs, module, false);
+
+ return f;
+}
+
+FILE *
+gfc_open_intrinsic_module (const char *name)
+{
+ FILE *f = NULL;
+
+ if (IS_ABSOLUTE_PATH (name))
+ {
+ f = gfc_open_file (name);
+ if (f && gfc_cpp_makedep ())
+ gfc_cpp_add_dep (name, true);
+ }
+
+ if (!f)
+ f = open_included_file (name, intrinsic_modules_dirs, true, true);
+
+ return f;
+}
+
+
/* Test to see if we're at the end of the main source file. */
int
gfc_at_end (void)
{
-
return end_flag;
}
@@ -214,7 +473,6 @@ gfc_at_end (void)
int
gfc_at_eof (void)
{
-
if (gfc_at_end ())
return 1;
@@ -245,13 +503,66 @@ gfc_at_bol (void)
int
gfc_at_eol (void)
{
-
if (gfc_at_eof ())
return 1;
return (*gfc_current_locus.nextc == '\0');
}
+static void
+add_file_change (const char *filename, int line)
+{
+ if (file_changes_count == file_changes_allocated)
+ {
+ if (file_changes_allocated)
+ file_changes_allocated *= 2;
+ else
+ file_changes_allocated = 16;
+ file_changes = XRESIZEVEC (struct gfc_file_change, file_changes,
+ file_changes_allocated);
+ }
+ file_changes[file_changes_count].filename = filename;
+ file_changes[file_changes_count].lb = NULL;
+ file_changes[file_changes_count++].line = line;
+}
+
+static void
+report_file_change (gfc_linebuf *lb)
+{
+ size_t c = file_changes_cur;
+ while (c < file_changes_count
+ && file_changes[c].lb == lb)
+ {
+ if (file_changes[c].filename)
+ (*debug_hooks->start_source_file) (file_changes[c].line,
+ file_changes[c].filename);
+ else
+ (*debug_hooks->end_source_file) (file_changes[c].line);
+ ++c;
+ }
+ file_changes_cur = c;
+}
+
+void
+gfc_start_source_files (void)
+{
+ /* If the debugger wants the name of the main source file,
+ we give it. */
+ if (debug_hooks->start_end_main_source_file)
+ (*debug_hooks->start_source_file) (0, gfc_source_file);
+
+ file_changes_cur = 0;
+ report_file_change (gfc_current_locus.lb);
+}
+
+void
+gfc_end_source_files (void)
+{
+ report_file_change (NULL);
+
+ if (debug_hooks->start_end_main_source_file)
+ (*debug_hooks->end_source_file) (0);
+}
/* Advance the current line pointer to the next line. */
@@ -267,9 +578,16 @@ gfc_advance_line (void)
return;
}
+ if (gfc_current_locus.lb->next
+ && !gfc_current_locus.lb->next->dbg_emitted)
+ {
+ report_file_change (gfc_current_locus.lb->next);
+ gfc_current_locus.lb->next->dbg_emitted = true;
+ }
+
gfc_current_locus.lb = gfc_current_locus.lb->next;
- if (gfc_current_locus.lb != NULL)
+ if (gfc_current_locus.lb != NULL)
gfc_current_locus.nextc = gfc_current_locus.lb->line;
else
{
@@ -288,10 +606,10 @@ gfc_advance_line (void)
pointer from being on the wrong line if the current statement ends
prematurely. */
-static int
+static gfc_char_t
next_char (void)
{
- int c;
+ gfc_char_t c;
if (gfc_current_locus.nextc == NULL)
return '\n';
@@ -306,15 +624,16 @@ next_char (void)
return c;
}
+
/* 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
+ compiler directives within comments, here is where we parse the
directive. */
static void
skip_comment_line (void)
{
- char c;
+ gfc_char_t c;
do
{
@@ -326,6 +645,66 @@ skip_comment_line (void)
}
+int
+gfc_define_undef_line (void)
+{
+ char *tmp;
+
+ /* All lines beginning with '#' are either #define or #undef. */
+ if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
+ return 0;
+
+ if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
+ {
+ tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
+ (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
+
+ if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
+ {
+ tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
+ (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
+ tmp);
+ gfc_free (tmp);
+ }
+
+ /* Skip the rest of the line. */
+ skip_comment_line ();
+
+ return 1;
+}
+
+
+/* Return true if GCC$ was matched. */
+static bool
+skip_gcc_attribute (locus start)
+{
+ bool r = false;
+ char c;
+ locus old_loc = gfc_current_locus;
+
+ if ((c = next_char ()) == 'g' || c == 'G')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == 'c' || c == 'C')
+ if ((c = next_char ()) == '$')
+ r = true;
+
+ if (r == false)
+ gfc_current_locus = old_loc;
+ else
+ {
+ gcc_attribute_flag = 1;
+ gcc_attribute_locus = old_loc;
+ gfc_current_locus = start;
+ }
+
+ return r;
+}
+
+
+
/* Comment lines are null lines, lines containing only blanks or lines
on which the first nonblank line is a '!'.
Return true if !$ openmp conditional compilation sentinel was
@@ -335,7 +714,7 @@ static bool
skip_free_comments (void)
{
locus start;
- char c;
+ gfc_char_t c;
int at_bol;
for (;;)
@@ -357,12 +736,16 @@ skip_free_comments (void)
if (c == '!')
{
+ /* Keep the !GCC$ line. */
+ if (at_bol && skip_gcc_attribute (start))
+ return false;
+
/* If -fopenmp, we need to handle here 2 things:
1) don't treat !$omp as comments, but directives
2) handle OpenMP conditional compilation, where
!$ should be treated as 2 spaces (for initial lines
only if followed by space). */
- if (gfc_option.flag_openmp && at_bol)
+ if (gfc_option.gfc_flag_openmp && at_bol)
{
locus old_loc = gfc_current_locus;
if (next_char () == '$')
@@ -371,24 +754,32 @@ skip_free_comments (void)
if (c == 'o' || c == 'O')
{
if (((c = next_char ()) == 'm' || c == 'M')
- && ((c = next_char ()) == 'p' || c == 'P')
- && ((c = next_char ()) == ' ' || continue_flag))
+ && ((c = next_char ()) == 'p' || c == 'P'))
{
- while (gfc_is_whitespace (c))
- c = next_char ();
- if (c != '\n' && c != '!')
+ if ((c = next_char ()) == ' ' || c == '\t'
+ || continue_flag)
{
- openmp_flag = 1;
- openmp_locus = old_loc;
- gfc_current_locus = start;
- return false;
+ while (gfc_is_whitespace (c))
+ c = next_char ();
+ if (c != '\n' && c != '!')
+ {
+ openmp_flag = 1;
+ openmp_locus = old_loc;
+ gfc_current_locus = start;
+ return false;
+ }
}
+ else
+ gfc_warning_now ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
}
gfc_current_locus = old_loc;
next_char ();
c = next_char ();
}
- if (continue_flag || c == ' ')
+ if (continue_flag || c == ' ' || c == '\t')
{
gfc_current_locus = old_loc;
next_char ();
@@ -407,6 +798,8 @@ skip_free_comments (void)
if (openmp_flag && at_bol)
openmp_flag = 0;
+
+ gcc_attribute_flag = 0;
gfc_current_locus = start;
return false;
}
@@ -422,7 +815,7 @@ skip_fixed_comments (void)
{
locus start;
int col;
- char c;
+ gfc_char_t c;
if (! gfc_at_bol ())
{
@@ -461,13 +854,24 @@ skip_fixed_comments (void)
if (c == '!' || c == 'c' || c == 'C' || c == '*')
{
+ if (skip_gcc_attribute (start))
+ {
+ /* Canonicalize to *$omp. */
+ *start.nextc = '*';
+ return;
+ }
+
/* If -fopenmp, we need to handle here 2 things:
1) don't treat !$omp|c$omp|*$omp as comments, but directives
2) handle OpenMP conditional compilation, where
!$|c$|*$ should be treated as 2 spaces if the characters
in columns 3 to 6 are valid fixed form label columns
characters. */
- if (gfc_option.flag_openmp)
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
+ if (gfc_option.gfc_flag_openmp)
{
if (next_char () == '$')
{
@@ -480,11 +884,11 @@ skip_fixed_comments (void)
c = next_char ();
if (c != '\n'
&& ((openmp_flag && continue_flag)
- || c == ' ' || c == '0'))
+ || c == ' ' || c == '\t' || c == '0'))
{
- c = next_char ();
- while (gfc_is_whitespace (c))
+ do
c = next_char ();
+ while (gfc_is_whitespace (c));
if (c != '\n' && c != '!')
{
/* Canonicalize to *$omp. */
@@ -503,6 +907,11 @@ skip_fixed_comments (void)
for (col = 3; col < 6; col++, c = next_char ())
if (c == ' ')
continue;
+ else if (c == '\t')
+ {
+ col = 6;
+ break;
+ }
else if (c < '0' || c > '9')
break;
else
@@ -510,7 +919,7 @@ skip_fixed_comments (void)
if (col == 6 && c != '\n'
&& ((continue_flag && !digit_seen)
- || c == ' ' || c == '0'))
+ || c == ' ' || c == '\t' || c == '0'))
{
gfc_current_locus = start;
start.nextc[0] = ' ';
@@ -552,6 +961,9 @@ skip_fixed_comments (void)
if (col != 6 && c == '!')
{
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
skip_comment_line ();
continue;
}
@@ -560,6 +972,7 @@ skip_fixed_comments (void)
}
openmp_flag = 0;
+ gcc_attribute_flag = 0;
gfc_current_locus = start;
}
@@ -583,11 +996,12 @@ gfc_skip_comments (void)
line. The in_string flag denotes whether we're inside a character
context or not. */
-int
-gfc_next_char_literal (int in_string)
+gfc_char_t
+gfc_next_char_literal (gfc_instring in_string)
{
locus old_loc;
- int i, c, prev_openmp_flag;
+ int i, prev_openmp_flag;
+ gfc_char_t c;
continue_flag = 0;
@@ -605,6 +1019,11 @@ restart:
if (!in_string && c == '!')
{
+ if (gcc_attribute_flag
+ && memcmp (&gfc_current_locus, &gcc_attribute_locus,
+ sizeof (gfc_current_locus)) == 0)
+ goto done;
+
if (openmp_flag
&& memcmp (&gfc_current_locus, &openmp_locus,
sizeof (gfc_current_locus)) == 0)
@@ -623,6 +1042,17 @@ restart:
goto done;
}
+ /* Check to see if the continuation line was truncated. */
+ if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+ && gfc_current_locus.lb->truncated)
+ {
+ int maxlen = gfc_option.free_line_length;
+ gfc_current_locus.lb->truncated = 0;
+ gfc_current_locus.nextc += maxlen;
+ gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+ gfc_current_locus.nextc -= maxlen;
+ }
+
if (c != '&')
goto done;
@@ -657,25 +1087,30 @@ restart:
skip_comment_line ();
else
gfc_advance_line ();
+
+ if (gfc_at_eof())
+ goto not_continuation;
/* We've got a continuation line. If we are on the very next line after
the last continuation, increment the continuation line count and
check whether the limit has been exceeded. */
- if (gfc_current_locus.lb->linenum == continue_line + 1)
+ if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_free)
{
- if (gfc_notification_std (GFC_STD_GNU)
- || pedantic)
- gfc_warning ("Limit of %d continuations exceeded in statement at %C",
- gfc_option.max_continue_free);
+ if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+ gfc_warning ("Limit of %d continuations exceeded in "
+ "statement at %C", gfc_option.max_continue_free);
}
}
- continue_line = gfc_current_locus.lb->linenum;
/* Now find where it continues. First eat any comment lines. */
openmp_cond_flag = skip_free_comments ();
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
if (prev_openmp_flag != openmp_flag)
{
gfc_current_locus = old_loc;
@@ -699,7 +1134,7 @@ restart:
{
for (i = 0; i < 5; i++, c = next_char ())
{
- gcc_assert (TOLOWER (c) == "!$omp"[i]);
+ gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
if (i == 4)
old_loc = gfc_current_locus;
}
@@ -711,9 +1146,10 @@ restart:
{
if (in_string)
{
- if (gfc_option.warn_ampersand)
- gfc_warning_now ("Missing '&' in continued character constant at %C");
gfc_current_locus.nextc--;
+ if (gfc_option.warn_ampersand && in_string == INSTRING_WARN)
+ gfc_warning ("Missing '&' in continued character "
+ "constant at %C");
}
/* Both !$omp and !$ -fopenmp continuation lines have & on the
continuation line only optionally. */
@@ -727,7 +1163,7 @@ restart:
}
}
}
- else
+ else /* Fixed form. */
{
/* Fixed form continuation. */
if (!in_string && c == '!')
@@ -746,6 +1182,14 @@ restart:
if (c != '\n')
goto done;
+ /* Check to see if the continuation line was truncated. */
+ if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+ && gfc_current_locus.lb->truncated)
+ {
+ gfc_current_locus.lb->truncated = 0;
+ gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+ }
+
prev_openmp_flag = openmp_flag;
continue_flag = 1;
old_loc = gfc_current_locus;
@@ -771,7 +1215,7 @@ restart:
for (i = 0; i < 5; i++)
{
c = next_char ();
- if (TOLOWER (c) != "*$omp"[i])
+ if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
goto not_continuation;
}
@@ -782,19 +1226,20 @@ restart:
/* We've got a continuation line. If we are on the very next line after
the last continuation, increment the continuation line count and
check whether the limit has been exceeded. */
- if (gfc_current_locus.lb->linenum == continue_line + 1)
+ if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
{
if (++continue_count == gfc_option.max_continue_fixed)
{
- if (gfc_notification_std (GFC_STD_GNU)
- || pedantic)
- gfc_warning ("Limit of %d continuations exceeded in statement at %C",
- gfc_option.max_continue_fixed);
+ if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+ gfc_warning ("Limit of %d continuations exceeded in "
+ "statement at %C",
+ gfc_option.max_continue_fixed);
}
}
- if (continue_line < gfc_current_locus.lb->linenum)
- continue_line = gfc_current_locus.lb->linenum;
+ if (gfc_current_locus.lb != NULL
+ && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+ continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
}
/* Ready to read first character of continuation line, which might
@@ -818,26 +1263,35 @@ done:
parsing character literals, they have to call
gfc_next_char_literal(). */
-int
+gfc_char_t
gfc_next_char (void)
{
- int c;
+ gfc_char_t c;
do
{
- c = gfc_next_char_literal (0);
+ c = gfc_next_char_literal (NONSTRING);
}
while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
- return TOLOWER (c);
+ return gfc_wide_tolower (c);
}
+char
+gfc_next_ascii_char (void)
+{
+ gfc_char_t c = gfc_next_char ();
-int
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
+gfc_char_t
gfc_peek_char (void)
{
locus old_loc;
- int c;
+ gfc_char_t c;
old_loc = gfc_current_locus;
c = gfc_next_char ();
@@ -847,6 +1301,16 @@ gfc_peek_char (void)
}
+char
+gfc_peek_ascii_char (void)
+{
+ gfc_char_t c = gfc_peek_char ();
+
+ return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+ : (unsigned char) UCHAR_MAX);
+}
+
+
/* Recover from an error. We try to get past the current statement
and get lined up for the next. The next statement follows a '\n'
or a ';'. We also assume that we are not within a character
@@ -855,7 +1319,7 @@ gfc_peek_char (void)
void
gfc_error_recovery (void)
{
- char c, delim;
+ gfc_char_t c, delim;
if (gfc_at_eof ())
return;
@@ -902,22 +1366,18 @@ gfc_gobble_whitespace (void)
{
static int linenum = 0;
locus old_loc;
- int c;
+ gfc_char_t c;
do
{
old_loc = gfc_current_locus;
- c = gfc_next_char_literal (0);
+ c = gfc_next_char_literal (NONSTRING);
/* Issue a warning for nonconforming tabs. We keep track of the line
number because the Fortran matchers will often back up and the same
line will be scanned multiple times. */
if (!gfc_option.warn_tabs && c == '\t')
{
-#ifdef USE_MAPPED_LOCATION
int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
-#else
- int cur_linenum = gfc_current_locus.lb->linenum;
-#endif
if (cur_linenum != linenum)
{
linenum = cur_linenum;
@@ -941,6 +1401,11 @@ gfc_gobble_whitespace (void)
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.
+
+ If first_char is not NULL, it's a pointer to a single char value holding
+ the first character of the line, which has already been read by the
+ caller. This avoids the use of ungetc().
+
load_line returns whether the line was truncated.
NOTE: The error machinery isn't available at this point, so we can't
@@ -948,13 +1413,14 @@ gfc_gobble_whitespace (void)
parts of gfortran. */
static int
-load_line (FILE * input, char **pbuf, int *pbuflen)
+load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
{
static int linenum = 0, current_line = 1;
int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
int trunc_flag = 0, seen_comment = 0;
- int seen_printable = 0, seen_ampersand = 0;
- char *buffer;
+ int seen_printable = 0, seen_ampersand = 0, quoted = ' ';
+ gfc_char_t *buffer;
+ bool found_tab = false;
/* Determine the maximum allowed line length. */
if (gfc_current_form == FORM_FREE)
@@ -976,95 +1442,106 @@ load_line (FILE * input, char **pbuf, int *pbuflen)
else
buflen = 132;
- *pbuf = gfc_getmem (buflen + 1);
+ *pbuf = gfc_get_wide_string (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);
+ if (first_char)
+ c = *first_char;
+ else
+ c = getc (input);
+
+ /* In order to not truncate preprocessor lines, we have to
+ remember that this is one. */
+ preprocessor_flag = (c == '#' ? 1 : 0);
for (;;)
{
- c = fgetc (input);
-
if (c == EOF)
break;
+
if (c == '\n')
{
/* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
if (gfc_current_form == FORM_FREE
- && !seen_printable && seen_ampersand)
+ && !seen_printable && seen_ampersand)
{
if (pedantic)
- gfc_error_now
- ("'&' not allowed by itself in line %d", current_line);
+ gfc_error_now ("'&' not allowed by itself in line %d",
+ current_line);
else
- gfc_warning_now
- ("'&' not allowed by itself in line %d", current_line);
+ gfc_warning_now ("'&' not allowed by itself in line %d",
+ current_line);
}
break;
}
- if (c == '\r')
- continue; /* Gobble characters. */
- if (c == '\0')
- continue;
-
- if (c == '\032')
- {
- /* Ctrl-Z ends the file. */
- while (fgetc (input) != EOF);
- break;
- }
+ if (c == '\r' || c == '\0')
+ goto next_char; /* Gobble characters. */
- /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3. */
if (c == '&')
- seen_ampersand = 1;
-
- if ((c != ' ' && c != '&' && c != '!') || (c == '!' && !seen_ampersand))
- seen_printable = 1;
-
- if (gfc_current_form == FORM_FREE
- && c == '!' && !seen_printable && seen_ampersand)
{
- if (pedantic)
- gfc_error_now (
- "'&' not allowed by itself with comment in line %d", current_line);
+ if (seen_ampersand)
+ {
+ seen_ampersand = 0;
+ seen_printable = 1;
+ }
else
- gfc_warning_now (
- "'&' not allowed by itself with comment in line %d", current_line);
- seen_printable = 1;
+ seen_ampersand = 1;
}
+ if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
+ seen_printable = 1;
+
/* Is this a fixed-form comment? */
if (gfc_current_form == FORM_FIXED && i == 0
&& (c == '*' || c == 'c' || c == 'd'))
seen_comment = 1;
- if (gfc_current_form == FORM_FIXED && c == '\t' && i <= 6)
+ if (quoted == ' ')
+ {
+ if (c == '\'' || c == '"')
+ quoted = c;
+ }
+ else if (c == quoted)
+ quoted = ' ';
+
+ /* Is this a free-form comment? */
+ if (c == '!' && quoted == ' ')
+ seen_comment = 1;
+
+ /* Vendor extension: "1" marks a continuation line. */
+ if (found_tab)
+ {
+ found_tab = false;
+ if (c >= '1' && c <= '9')
+ {
+ *(buffer-1) = c;
+ goto next_char;
+ }
+ }
+
+ if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
{
+ found_tab = true;
+
if (!gfc_option.warn_tabs && seen_comment == 0
&& current_line != linenum)
{
linenum = current_line;
- gfc_warning_now (
- "Nonconforming tab character in column 1 of line %d", linenum);
+ gfc_warning_now ("Nonconforming tab character in column %d "
+ "of line %d", i+1, linenum);
}
- while (i <= 6)
+ while (i < 6)
{
*buffer++ = ' ';
i++;
}
- continue;
+ goto next_char;
}
*buffer++ = c;
@@ -1077,24 +1554,48 @@ load_line (FILE * input, char **pbuf, int *pbuflen)
/* Reallocate line buffer to double size to hold the
overlong line. */
buflen = buflen * 2;
- *pbuf = xrealloc (*pbuf, buflen + 1);
- buffer = (*pbuf)+i;
+ *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1));
+ buffer = (*pbuf) + i;
}
}
else if (i >= maxlen)
{
+ bool trunc_warn = true;
+
+ /* Enhancement, if the very next non-space character is an ampersand
+ or comment that we would otherwise warn about, don't mark as
+ truncated. */
+
/* Truncate the rest of the line. */
for (;;)
{
- c = fgetc (input);
+ c = getc (input);
+ if (c == '\r' || c == ' ')
+ continue;
+
if (c == '\n' || c == EOF)
break;
- trunc_flag = 1;
+ if (!trunc_warn && c != '!')
+ trunc_warn = true;
+
+ if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&')
+ || c == '!'))
+ trunc_warn = false;
+
+ if (c == '!')
+ seen_comment = 1;
+
+ if (trunc_warn && !seen_comment)
+ trunc_flag = 1;
}
- ungetc ('\n', input);
+ c = '\n';
+ continue;
}
+
+next_char:
+ c = getc (input);
}
/* Pad lines to the selected line length in fixed form. */
@@ -1123,36 +1624,35 @@ get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
{
gfc_file *f;
- f = gfc_getmem (sizeof (gfc_file));
+ f = XCNEW (gfc_file);
- f->filename = gfc_getmem (strlen (name) + 1);
- strcpy (f->filename, name);
+ f->filename = xstrdup (name);
f->next = file_head;
file_head = f;
- f->included_by = current_file;
+ f->up = 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
+ linemap_add (line_table, reason, false, f->filename, 1);
return f;
}
+
/* Deal with a line from the C preprocessor. The
initial octothorp has already been seen. */
static void
-preprocessor_line (char *c)
+preprocessor_line (gfc_char_t *c)
{
bool flag[5];
int i, line;
- char *filename;
+ gfc_char_t *wide_filename;
gfc_file *f;
int escaped, unescape;
+ char *filename;
c++;
while (*c == ' ' || *c == '\t')
@@ -1161,9 +1661,9 @@ preprocessor_line (char *c)
if (*c < '0' || *c > '9')
goto bad_cpp_line;
- line = atoi (c);
+ line = wide_atoi (c);
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
{
/* No file name given. Set new line number. */
@@ -1180,15 +1680,15 @@ preprocessor_line (char *c)
goto bad_cpp_line;
++c;
- filename = c;
+ wide_filename = c;
/* Make filename end at quote. */
unescape = 0;
escaped = false;
- while (*c && ! (! escaped && *c == '"'))
+ while (*c && ! (!escaped && *c == '"'))
{
if (escaped)
- escaped = false;
+ escaped = false;
else if (*c == '\\')
{
escaped = true;
@@ -1206,10 +1706,10 @@ preprocessor_line (char *c)
/* Undo effects of cpp_quote_string. */
if (unescape)
{
- char *s = filename;
- char *d = gfc_getmem (c - filename - unescape);
+ gfc_char_t *s = wide_filename;
+ gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape);
- filename = d;
+ wide_filename = d;
while (*s)
{
if (*s == '\\')
@@ -1227,23 +1727,27 @@ preprocessor_line (char *c)
for (;;)
{
- c = strchr (c, ' ');
+ c = wide_strchr (c, ' ');
if (c == NULL)
break;
c++;
- i = atoi (c);
+ i = wide_atoi (c);
if (1 <= i && i <= 4)
flag[i] = true;
}
+ /* Convert the filename in wide characters into a filename in narrow
+ characters. */
+ filename = gfc_widechar_to_char (wide_filename, -1);
+
/* Interpret flags. */
if (flag[1]) /* Starting new file. */
{
f = get_file (filename, LC_RENAME);
- f->up = current_file;
+ add_file_change (f->filename, f->inclusion_line);
current_file = f;
}
@@ -1256,10 +1760,15 @@ preprocessor_line (char *c)
current_file->filename, current_file->line,
filename);
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
}
+
+ add_file_change (NULL, line);
current_file = current_file->up;
+ linemap_add (line_table, LC_RENAME, false, current_file->filename,
+ current_file->line);
}
/* The name of the file can be a temporary file produced by
@@ -1267,15 +1776,17 @@ preprocessor_line (char *c)
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);
+ /* FIXME: we leak the old filename because a pointer to it may be stored
+ in the linemap. Alternative could be using GC or updating linemap to
+ point to the new name, but there is no API for that currently. */
+ current_file->filename = xstrdup (filename);
}
/* Set new line number. */
current_file->line = line;
if (unescape)
- gfc_free (filename);
+ gfc_free (wide_filename);
+ gfc_free (filename);
return;
bad_cpp_line:
@@ -1285,7 +1796,7 @@ preprocessor_line (char *c)
}
-static try load_file (const char *, bool);
+static gfc_try load_file (const char *, const 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
@@ -1294,13 +1805,14 @@ static try load_file (const char *, bool);
processed or true if we matched an include. */
static bool
-include_line (char *line)
+include_line (gfc_char_t *line)
{
- char quote, *c, *begin, *stop;
+ gfc_char_t quote, *c, *begin, *stop;
+ char *filename;
c = line;
- if (gfc_option.flag_openmp)
+ if (gfc_option.gfc_flag_openmp)
{
if (gfc_current_form == FORM_FREE)
{
@@ -1320,8 +1832,8 @@ include_line (char *line)
while (*c == ' ' || *c == '\t')
c++;
- if (strncasecmp (c, "include", 7))
- return false;
+ if (gfc_wide_strncasecmp (c, "include", 7))
+ return false;
c += 7;
while (*c == ' ' || *c == '\t')
@@ -1354,25 +1866,36 @@ include_line (char *line)
*stop = '\0'; /* It's ok to trash the buffer, as this line won't be
read by anything else. */
- load_file (begin, false);
+ filename = gfc_widechar_to_char (begin, -1);
+ if (load_file (filename, NULL, false) == FAILURE)
+ exit (1);
+
+ gfc_free (filename);
return true;
}
+
/* Load a file into memory by calling load_line until the file ends. */
-static try
-load_file (const char *filename, bool initial)
+static gfc_try
+load_file (const char *realfilename, const char *displayedname, bool initial)
{
- char *line;
+ gfc_char_t *line;
gfc_linebuf *b;
gfc_file *f;
FILE *input;
int len, line_len;
+ bool first_line;
+ const char *filename;
+
+ filename = displayedname ? displayedname : realfilename;
for (f = current_file; f; f = f->up)
if (strcmp (filename, f->filename) == 0)
{
- gfc_error_now ("File '%s' is being included recursively", filename);
+ fprintf (stderr, "%s:%d: Error: File '%s' is being included "
+ "recursively\n", current_file->filename, current_file->line,
+ filename);
return FAILURE;
}
@@ -1384,7 +1907,7 @@ load_file (const char *filename, bool initial)
gfc_src_file = NULL;
}
else
- input = gfc_open_file (filename);
+ input = gfc_open_file (realfilename);
if (input == NULL)
{
gfc_error_now ("Can't open file '%s'", filename);
@@ -1393,10 +1916,11 @@ load_file (const char *filename, bool initial)
}
else
{
- input = gfc_open_included_file (filename, false);
+ input = gfc_open_included_file (realfilename, false, false);
if (input == NULL)
{
- gfc_error_now ("Can't open included file '%s'", filename);
+ fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n",
+ current_file->filename, current_file->line, filename);
return FAILURE;
}
}
@@ -1404,11 +1928,13 @@ load_file (const char *filename, bool initial)
/* Load the file. */
f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
- f->up = current_file;
+ if (!initial)
+ add_file_change (f->filename, f->inclusion_line);
current_file = f;
current_file->line = 1;
line = NULL;
line_len = 0;
+ first_line = true;
if (initial && gfc_src_preprocessor_lines[0])
{
@@ -1425,21 +1951,59 @@ load_file (const char *filename, bool initial)
for (;;)
{
- int trunc = load_line (input, &line, &line_len);
+ int trunc = load_line (input, &line, &line_len, NULL);
- len = strlen (line);
+ len = gfc_wide_strlen (line);
if (feof (input) && len == 0)
break;
+ /* If this is the first line of the file, it can contain a byte
+ order mark (BOM), which we will ignore:
+ FF FE is UTF-16 little endian,
+ FE FF is UTF-16 big endian,
+ EF BB BF is UTF-8. */
+ if (first_line
+ && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
+ && line[1] == (unsigned char) '\xFE')
+ || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
+ && line[1] == (unsigned char) '\xFF')
+ || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
+ && line[1] == (unsigned char) '\xBB'
+ && line[2] == (unsigned char) '\xBF')))
+ {
+ int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
+ gfc_char_t *new_char = gfc_get_wide_string (line_len);
+
+ wide_strcpy (new_char, &line[n]);
+ gfc_free (line);
+ line = new_char;
+ len -= n;
+ }
+
/* There are three things this line can be: a line of Fortran
source, an include line or a C preprocessor directive. */
if (line[0] == '#')
{
- preprocessor_line (line);
- continue;
+ /* When -g3 is specified, it's possible that we emit #define
+ and #undef lines, which we need to pass to the middle-end
+ so that it can emit correct debug info. */
+ if (debug_info_level == DINFO_LEVEL_VERBOSE
+ && (wide_strncmp (line, "#define ", 8) == 0
+ || wide_strncmp (line, "#undef ", 7) == 0))
+ ;
+ else
+ {
+ preprocessor_line (line);
+ continue;
+ }
}
+ /* Preprocessed files have preprocessor lines added before the byte
+ order mark, so first_line is not about the first line of the file
+ but the first line that's not a preprocessor line. */
+ first_line = false;
+
if (include_line (line))
{
current_file->line++;
@@ -1448,17 +2012,14 @@ load_file (const char *filename, bool initial)
/* Add line. */
- b = gfc_getmem (gfc_linebuf_header_size + len + 1);
+ b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size
+ + (len + 1) * sizeof (gfc_char_t));
-#ifdef USE_MAPPED_LOCATION
b->location
- = linemap_line_start (&line_table, current_file->line++, 120);
-#else
- b->linenum = current_file->line++;
-#endif
+ = linemap_line_start (line_table, current_file->line++, 120);
b->file = current_file;
b->truncated = trunc;
- strcpy (b->line, line);
+ wide_strcpy (b->line, line);
if (line_head == NULL)
line_head = b;
@@ -1466,6 +2027,9 @@ load_file (const char *filename, bool initial)
line_tail->next = b;
line_tail = b;
+
+ while (file_changes_cur < file_changes_count)
+ file_changes[file_changes_cur++].lb = b;
}
/* Release the line buffer allocated in load_line. */
@@ -1473,38 +2037,40 @@ load_file (const char *filename, bool initial)
fclose (input);
+ if (!initial)
+ add_file_change (NULL, current_file->inclusion_line + 1);
current_file = current_file->up;
-#ifdef USE_MAPPED_LOCATION
- linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
-#endif
+ linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
return SUCCESS;
}
/* Open a new file and start scanning from that file. Returns SUCCESS
- if everything went OK, FAILURE otherwise. If form == FORM_UKNOWN
+ if everything went OK, FAILURE otherwise. If form == FORM_UNKNOWN
it tries to determine the source form from the filename, defaulting
to free form. */
-try
+gfc_try
gfc_new_file (void)
{
- try result;
+ gfc_try result;
- result = load_file (gfc_source_file, true);
+ if (gfc_cpp_enabled ())
+ {
+ result = gfc_cpp_preprocess (gfc_source_file);
+ if (!gfc_cpp_preprocess_only ())
+ result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
+ }
+ else
+ result = load_file (gfc_source_file, NULL, true);
gfc_current_locus.lb = line_head;
gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
#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);
+ printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
+ LOCATION_LINE (line_head->location), line_head->line);
exit (0);
#endif
@@ -1533,12 +2099,12 @@ unescape_filename (const char *ptr)
++p;
}
- if (! *p || p[1])
+ if (!*p || p[1])
return NULL;
/* Undo effects of cpp_quote_string. */
s = ptr;
- d = gfc_getmem (p + 1 - ptr - unescape);
+ d = XCNEWVEC (char, p + 1 - ptr - unescape);
ret = d;
while (s != p)
@@ -1560,41 +2126,43 @@ const char *
gfc_read_orig_filename (const char *filename, const char **canon_source_file)
{
int c, len;
- char *dirname;
+ char *dirname, *tmp;
gfc_src_file = gfc_open_file (filename);
if (gfc_src_file == NULL)
return NULL;
- c = fgetc (gfc_src_file);
- ungetc (c, gfc_src_file);
+ c = getc (gfc_src_file);
if (c != '#')
return NULL;
len = 0;
- load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
+ load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c);
- if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
return NULL;
- filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
+ tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
+ filename = unescape_filename (tmp);
+ gfc_free (tmp);
if (filename == NULL)
return NULL;
- c = fgetc (gfc_src_file);
- ungetc (c, gfc_src_file);
+ c = getc (gfc_src_file);
if (c != '#')
return filename;
len = 0;
- load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
+ load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c);
- if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+ if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
return filename;
- dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
+ tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
+ dirname = unescape_filename (tmp);
+ gfc_free (tmp);
if (dirname == NULL)
return filename;
@@ -1609,7 +2177,7 @@ gfc_read_orig_filename (const char *filename, const char **canon_source_file)
if (! IS_ABSOLUTE_PATH (filename))
{
- char *p = gfc_getmem (len + strlen (filename));
+ char *p = XCNEWVEC (char, len + strlen (filename));
memcpy (p, dirname, len - 2);
p[len - 2] = '/';