diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c395a0ce7fc..37f100d4ce7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2006-01-27 Jakub Jelinek + + 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 * symbol.c (free_old_symbol): Fix confusing comment, and add code diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index 260d6c54d8c..622892823ed 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -269,6 +269,7 @@ GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/intrinsic.h fortran/trans-array 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 \ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index c14b04dac6d..c8813ec070a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1516,6 +1516,7 @@ typedef struct int flag_no_backend; int flag_pack_derived; int flag_repack_arrays; + int flag_preprocessed; int flag_f2c; int flag_automatic; int flag_backslash; @@ -1596,6 +1597,7 @@ int gfc_peek_char (void); 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; diff --git a/gcc/fortran/lang-specs.h b/gcc/fortran/lang-specs.h index 688fbc1f276..eac5caa41c7 100644 --- a/gcc/fortran/lang-specs.h +++ b/gcc/fortran/lang-specs.h @@ -1,6 +1,6 @@ /* 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. */ @@ -15,7 +15,7 @@ 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", @@ -23,7 +23,7 @@ This file is licensed under the GPL. */ %{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*}\ diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index e17bfa54e01..465d589813a 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -173,6 +173,10 @@ frepack-arrays 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= Set the kind for a real with the 'q' exponent to 'n' diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 64fa8a27441..d65827c9bb3 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -72,6 +72,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, 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; @@ -172,7 +173,7 @@ form_from_filename (const char *filename) bool gfc_post_options (const char **pfilename) { - const char *filename = *pfilename; + const char *filename = *pfilename, *canon_source_file = NULL; char *source_path; int i; @@ -182,23 +183,40 @@ gfc_post_options (const char **pfilename) 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) @@ -211,7 +229,7 @@ gfc_post_options (const char **pfilename) { gfc_current_form = FORM_FREE; gfc_warning_now ("Reading file '%s' as free form.", - (filename[0] == '\0') ? "" : filename); + (filename[0] == '\0') ? "" : filename); } } @@ -478,6 +496,10 @@ gfc_handle_option (size_t scode, const char *arg, int value) 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", diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 0b21e96497e..690d6d78766 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -45,6 +45,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #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 @@ -66,7 +67,9 @@ 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]; + /* Main scanner initialization. */ @@ -861,7 +864,7 @@ preprocessor_line (char *c) int i, line; char *filename; gfc_file *f; - int escaped; + int escaped, unescape; c++; while (*c == ' ' || *c == '\t') @@ -892,13 +895,17 @@ preprocessor_line (char *c) 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; } @@ -908,7 +915,23 @@ preprocessor_line (char *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. */ @@ -944,6 +967,8 @@ preprocessor_line (char *c) 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; @@ -961,6 +986,8 @@ preprocessor_line (char *c) /* Set new line number. */ current_file->line = line; + if (unescape) + gfc_free (filename); return; bad_cpp_line: @@ -1045,7 +1072,13 @@ load_file (const char *filename, bool initial) 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); @@ -1071,6 +1104,19 @@ load_file (const char *filename, bool initial) 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); @@ -1159,3 +1205,112 @@ gfc_new_file (void) 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; +}