* Make-lang.in (fortran/scanner.o): Depend on toplev.h.
* lang.opt (fpreprocessed): New option.
* scanner.c: Include toplev.h.
(gfc_src_file, gfc_src_preprocessor_lines): New variables.
(preprocessor_line): Unescape filename if there were any
backslashes.
(load_file): If initial and gfc_src_file is not NULL,
use it rather than opening the file. If gfc_src_preprocessor_lines
has non-NULL elements, pass it to preprocessor_line.
(unescape_filename, gfc_read_orig_filename): New functions.
* gfortran.h (gfc_option_t): Add flag_preprocessed.
(gfc_read_orig_filename): New prototype.
* options.c (gfc_init_options): Clear flag_preprocessed.
(gfc_post_options): If flag_preprocessed, call
gfc_read_orig_filename.
(gfc_handle_option): Handle OPT_fpreprocessed.
* lang-specs.h: Pass -fpreprocessed to f951 if preprocessing
sources.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@110304
138bc75d-0d04-0410-961f-
82ee72b054a4
+2006-01-27 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/25324
+ * Make-lang.in (fortran/scanner.o): Depend on toplev.h.
+ * lang.opt (fpreprocessed): New option.
+ * scanner.c: Include toplev.h.
+ (gfc_src_file, gfc_src_preprocessor_lines): New variables.
+ (preprocessor_line): Unescape filename if there were any
+ backslashes.
+ (load_file): If initial and gfc_src_file is not NULL,
+ use it rather than opening the file. If gfc_src_preprocessor_lines
+ has non-NULL elements, pass it to preprocessor_line.
+ (unescape_filename, gfc_read_orig_filename): New functions.
+ * gfortran.h (gfc_option_t): Add flag_preprocessed.
+ (gfc_read_orig_filename): New prototype.
+ * options.c (gfc_init_options): Clear flag_preprocessed.
+ (gfc_post_options): If flag_preprocessed, call
+ gfc_read_orig_filename.
+ (gfc_handle_option): Handle OPT_fpreprocessed.
+ * lang-specs.h: Pass -fpreprocessed to f951 if preprocessing
+ sources.
+
2005-01-27 Erik Edelmann <eedelman@gcc.gnu.org>
* symbol.c (free_old_symbol): Fix confusing comment, and add code
fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-f95-lang.h gtype-fortran.h cgraph.h $(TARGET_H)
+fortran/scanner.o: toplev.h
fortran/convert.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
int flag_no_backend;
int flag_pack_derived;
int flag_repack_arrays;
+ int flag_preprocessed;
int flag_f2c;
int flag_automatic;
int flag_backslash;
void gfc_error_recovery (void);
void gfc_gobble_whitespace (void);
try gfc_new_file (void);
+const char * gfc_read_orig_filename (const char *, const char **);
extern gfc_source_form gfc_current_form;
extern const char *gfc_source_file;
/* Contribution to the specs for the GNU Compiler Collection
from GNU Fortran 95 compiler.
- Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
This file is licensed under the GPL. */
%{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f |\n\
f951 %|.f %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
- %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
+ -fpreprocessed %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".F90", "@f95-cpp-input", 0, 0, 0},
{".F95", "@f95-cpp-input", 0, 0, 0},
{"@f95-cpp-input",
%{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f95 |\n\
f951 %|.f95 %(cc1_options) %{J*} %{I*}\
- %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
+ -fpreprocessed %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".f90", "@f95", 0, 0, 0},
{".f95", "@f95", 0, 0, 0},
{"@f95", "%{!E:f951 %i %(cc1_options) %{J*} %{I*}\
Fortran
Copy array sections into a contiguous block on procedure entry
+fpreprocessed
+Fortran
+Treat the input file as preprocessed
+
qkind=
Fortran RejectNegative Joined UInteger
-qkind=<n> Set the kind for a real with the 'q' exponent to 'n'
gfc_option.flag_no_backend = 0;
gfc_option.flag_pack_derived = 0;
gfc_option.flag_repack_arrays = 0;
+ gfc_option.flag_preprocessed = 0;
gfc_option.flag_automatic = 1;
gfc_option.flag_backslash = 1;
gfc_option.flag_cray_pointer = 0;
bool
gfc_post_options (const char **pfilename)
{
- const char *filename = *pfilename;
+ const char *filename = *pfilename, *canon_source_file = NULL;
char *source_path;
int i;
filename = "";
}
- gfc_source_file = filename;
+ if (gfc_option.flag_preprocessed)
+ {
+ /* For preprocessed files, if the first tokens are of the form # NUM.
+ handle the directives so we know the original file name. */
+ gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
+ if (gfc_source_file == NULL)
+ gfc_source_file = filename;
+ else
+ *pfilename = gfc_source_file;
+ }
+ else
+ gfc_source_file = filename;
+
+ if (canon_source_file == NULL)
+ canon_source_file = gfc_source_file;
/* Adds the path where the source file is to the list of include files. */
- i = strlen(gfc_source_file);
- while (i > 0 && !IS_DIR_SEPARATOR(gfc_source_file[i]))
+ i = strlen (canon_source_file);
+ while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
i--;
if (i != 0)
{
source_path = alloca (i + 1);
- memcpy (source_path, gfc_source_file, i);
+ memcpy (source_path, canon_source_file, i);
source_path[i] = 0;
gfc_add_include_path (source_path);
}
else
gfc_add_include_path (".");
+ if (canon_source_file != gfc_source_file)
+ gfc_free ((void *) canon_source_file);
+
/* Decide which form the file will be read in as. */
if (gfc_option.source_form != FORM_UNKNOWN)
{
gfc_current_form = FORM_FREE;
gfc_warning_now ("Reading file '%s' as free form.",
- (filename[0] == '\0') ? "<stdin>" : filename);
+ (filename[0] == '\0') ? "<stdin>" : filename);
}
}
gfc_option.flag_repack_arrays = value;
break;
+ case OPT_fpreprocessed:
+ gfc_option.flag_preprocessed = value;
+ break;
+
case OPT_fmax_identifier_length_:
if (value > GFC_MAX_SYMBOL_LEN)
gfc_fatal_error ("Maximum supported idenitifier length is %d",
#include "config.h"
#include "system.h"
#include "gfortran.h"
+#include "toplev.h"
/* Structure for holding module and include file search path. */
typedef struct gfc_directorylist
locus gfc_current_locus;
const char *gfc_source_file;
-
+static FILE *gfc_src_file;
+static char *gfc_src_preprocessor_lines[2];
+
/* Main scanner initialization. */
int i, line;
char *filename;
gfc_file *f;
- int escaped;
+ int escaped, unescape;
c++;
while (*c == ' ' || *c == '\t')
filename = c;
/* Make filename end at quote. */
+ unescape = 0;
escaped = false;
while (*c && ! (! escaped && *c == '"'))
{
if (escaped)
escaped = false;
- else
- escaped = *c == '\\';
+ else if (*c == '\\')
+ {
+ escaped = true;
+ unescape++;
+ }
++c;
}
*c++ = '\0';
+ /* Undo effects of cpp_quote_string. */
+ if (unescape)
+ {
+ char *s = filename;
+ char *d = gfc_getmem (c - filename - unescape);
+ filename = d;
+ while (*s)
+ {
+ if (*s == '\\')
+ *d++ = *++s;
+ else
+ *d++ = *s;
+ s++;
+ }
+ *d = '\0';
+ }
/* Get flags. */
gfc_warning_now ("%s:%d: file %s left but not entered",
current_file->filename, current_file->line,
filename);
+ if (unescape)
+ gfc_free (filename);
return;
}
current_file = current_file->up;
/* Set new line number. */
current_file->line = line;
+ if (unescape)
+ gfc_free (filename);
return;
bad_cpp_line:
if (initial)
{
- input = gfc_open_file (filename);
+ if (gfc_src_file)
+ {
+ input = gfc_src_file;
+ gfc_src_file = NULL;
+ }
+ else
+ input = gfc_open_file (filename);
if (input == NULL)
{
gfc_error_now ("Can't open file '%s'", filename);
line = NULL;
line_len = 0;
+ if (initial && gfc_src_preprocessor_lines[0])
+ {
+ preprocessor_line (gfc_src_preprocessor_lines[0]);
+ gfc_free (gfc_src_preprocessor_lines[0]);
+ gfc_src_preprocessor_lines[0] = NULL;
+ if (gfc_src_preprocessor_lines[1])
+ {
+ preprocessor_line (gfc_src_preprocessor_lines[1]);
+ gfc_free (gfc_src_preprocessor_lines[1]);
+ gfc_src_preprocessor_lines[1] = NULL;
+ }
+ }
+
for (;;)
{
int trunc = load_line (input, &line, &line_len);
return result;
}
+
+static char *
+unescape_filename (const char *ptr)
+{
+ const char *p = ptr, *s;
+ char *d, *ret;
+ int escaped, unescape = 0;
+
+ /* Make filename end at quote. */
+ escaped = false;
+ while (*p && ! (! escaped && *p == '"'))
+ {
+ if (escaped)
+ escaped = false;
+ else if (*p == '\\')
+ {
+ escaped = true;
+ unescape++;
+ }
+ ++p;
+ }
+
+ if (! *p || p[1])
+ return NULL;
+
+ /* Undo effects of cpp_quote_string. */
+ s = ptr;
+ d = gfc_getmem (p + 1 - ptr - unescape);
+ ret = d;
+
+ while (s != p)
+ {
+ if (*s == '\\')
+ *d++ = *++s;
+ else
+ *d++ = *s;
+ s++;
+ }
+ *d = '\0';
+ return ret;
+}
+
+/* For preprocessed files, if the first tokens are of the form # NUM.
+ handle the directives so we know the original file name. */
+
+const char *
+gfc_read_orig_filename (const char *filename, const char **canon_source_file)
+{
+ int c, len;
+ char *dirname;
+
+ gfc_src_file = gfc_open_file (filename);
+ if (gfc_src_file == NULL)
+ return NULL;
+
+ c = fgetc (gfc_src_file);
+ ungetc (c, gfc_src_file);
+
+ if (c != '#')
+ return NULL;
+
+ len = 0;
+ load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len);
+
+ if (strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+ return NULL;
+
+ filename = unescape_filename (gfc_src_preprocessor_lines[0] + 5);
+ if (filename == NULL)
+ return NULL;
+
+ c = fgetc (gfc_src_file);
+ ungetc (c, gfc_src_file);
+
+ if (c != '#')
+ return filename;
+
+ len = 0;
+ load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len);
+
+ if (strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+ return filename;
+
+ dirname = unescape_filename (gfc_src_preprocessor_lines[1] + 5);
+ if (dirname == NULL)
+ return filename;
+
+ len = strlen (dirname);
+ if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
+ {
+ gfc_free (dirname);
+ return filename;
+ }
+ dirname[len - 2] = '\0';
+ set_src_pwd (dirname);
+
+ if (! IS_ABSOLUTE_PATH (filename))
+ {
+ char *p = gfc_getmem (len + strlen (filename));
+
+ memcpy (p, dirname, len - 2);
+ p[len - 2] = '/';
+ strcpy (p + len - 1, filename);
+ *canon_source_file = p;
+ }
+
+ gfc_free (dirname);
+ return filename;
+}
OSDN Git Service
