re PR fortran/25324 (Wrong DW_TAG_compile_unit generated when compiling preprocessed fortran code)

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.

From-SVN: r110304

gcc/fortran/ChangeLog

@@ -1,3 +1,25 @@
+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

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 \

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;

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*}\

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=<n>	Set the kind for a real with the 'q' exponent to 'n'

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);
+  i = strlen (canon_source_file);
-  while (i > 0 && !IS_DIR_SEPARATOR(gfc_source_file[i]))
+  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') ? "<stdin>" : filename); 
+			   (filename[0] == '\0') ? "<stdin>" : 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",

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
+      else if (*c == '\\')
-        escaped = *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;
+}