Commit d4fa05b9 by Tobias Schlüter Committed by Tobias Schlüter

re PR fortran/13702 (When preprocessing Fortran files (.F, .F90 and .F95) cpp…

re PR fortran/13702 (When preprocessing Fortran files (.F, .F90 and .F95) cpp should emit line numbers.)

PR fortran/13702
(Port from g95)
* gfortran.h (gfc_linebuf): New typedef.
(linebuf): Remove.
(gfc_file): Revamped, use new gfc_linebuf.
(locus): Revamped, use new types.
(gfc_current_file): Remove.
(gfc_current_form, gfc_source_file): New global variables.
* match.c (gfc_match_space, gfc_match_strings): Use
gfc_current_form to find source form.
* module.c (gfc_dump_module): Use gfc_source_file when printing
module header.
* error.c (show_locus, show_loci) Use new data structures to print
locus.
* scanner.c (first_file, first_duplicated_file, gfc_current_file):
Remove.
(file_head, current_file, gfc_current_form, line_head, line_tail,
gfc_current_locus1, gfc_source_file): New global variables.
(gfc_scanner_init1): Set new global variables.
(gfc_scanner_done1): Free new data structures.
(gfc_current_locus): Return pointer to gfc_current_locus1.
(gfc_set_locus): Set gfc_current_locus1.
(gfc_at_eof): Set new variables.
(gfc_at_bol, gfc_at_eol, gfc_advance_line, gfc_next_char): Adapt
to new locus structure.
(gfc_check_include): Remove.
(skip_free_comments, skip_fixed_comments): Use gfc_current_locus1.
(gfc_skip_comments): Use gfc_current_form, find locus with
gfc_current_locus1.
(gfc_next_char): Use gfc_current_form.
(gfc_peek_char, gfc_gobble_whitespace): Use gfc_current_locus1.
(load_line): Use gfc_current_form. Recognize ^Z as EOF. Fix
comment formatting.
(get_file): New function.
(preprocessor_line, include_line): New functions.
(load_file): Move down, rewrite to match new data structures.
(gfc_new_file): Rewrite to match new data structures.
* parse.c (next_statement): Remove code which is now useless. Use
gfc_source_form and gfc_source_file where appropriate.
* trans-decl.c (gfc_get_label_decl): adapt to new data structures
when determining locus of frontend code.
* trans-io.c (set_error_locus): Same.
* trans.c (gfc_get_backend_locus, gfc_set_backend_locus): Likewise.
* lang-specs.h (@f77-cpp-input, @f95-cpp-input): Remove '-P' from
preprocessor flags.
(all): Add missing initializers.

From-SVN: r81888
parent 39ae2b01
2004-05-15 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/13702
(Port from g95)
* gfortran.h (gfc_linebuf): New typedef.
(linebuf): Remove.
(gfc_file): Revamped, use new gfc_linebuf.
(locus): Revamped, use new types.
(gfc_current_file): Remove.
(gfc_current_form, gfc_source_file): New global variables.
* match.c (gfc_match_space, gfc_match_strings): Use
gfc_current_form to find source form.
* module.c (gfc_dump_module): Use gfc_source_file when printing
module header.
* error.c (show_locus, show_loci) Use new data structures to print
locus.
* scanner.c (first_file, first_duplicated_file, gfc_current_file):
Remove.
(file_head, current_file, gfc_current_form, line_head, line_tail,
gfc_current_locus1, gfc_source_file): New global variables.
(gfc_scanner_init1): Set new global variables.
(gfc_scanner_done1): Free new data structures.
(gfc_current_locus): Return pointer to gfc_current_locus1.
(gfc_set_locus): Set gfc_current_locus1.
(gfc_at_eof): Set new variables.
(gfc_at_bol, gfc_at_eol, gfc_advance_line, gfc_next_char): Adapt
to new locus structure.
(gfc_check_include): Remove.
(skip_free_comments, skip_fixed_comments): Use gfc_current_locus1.
(gfc_skip_comments): Use gfc_current_form, find locus with
gfc_current_locus1.
(gfc_next_char): Use gfc_current_form.
(gfc_peek_char, gfc_gobble_whitespace): Use gfc_current_locus1.
(load_line): Use gfc_current_form. Recognize ^Z as EOF. Fix
comment formatting.
(get_file): New function.
(preprocessor_line, include_line): New functions.
(load_file): Move down, rewrite to match new data structures.
(gfc_new_file): Rewrite to match new data structures.
* parse.c (next_statement): Remove code which is now useless. Use
gfc_source_form and gfc_source_file where appropriate.
* trans-decl.c (gfc_get_label_decl): adapt to new data structures
when determining locus of frontend code.
* trans-io.c (set_error_locus): Same.
* trans.c (gfc_get_backend_locus, gfc_set_backend_locus): Likewise.
* lang-specs.h (@f77-cpp-input, @f95-cpp-input): Remove '-P' from
preprocessor flags.
(all): Add missing initializers.
2004-05-15 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* Make-lang.in (trans-common.o): Remove redundant dependency.
(data.c): Replace object file name ...
(data.o): ... by the correct one.
......
......@@ -118,8 +118,9 @@ error_string (const char *p)
static void error_printf (const char *, ...) ATTRIBUTE_PRINTF_1;
static void
show_locus (int offset, locus * l)
show_locus (int offset, locus * loc)
{
gfc_linebuf *lb;
gfc_file *f;
char c, *p;
int i, m;
......@@ -127,20 +128,25 @@ show_locus (int offset, locus * l)
/* TODO: Either limit the total length and number of included files
displayed or add buffering of arbitrary number of characters in
error messages. */
f = l->file;
error_printf ("In file %s:%d\n", f->filename, l->lp->start_line + l->line);
f = f->included_by;
while (f != NULL)
lb = loc->lb;
f = lb->file;
error_printf ("In file %s:%d\n", f->filename, lb->linenum);
for (;;)
{
error_printf (" Included at %s:%d\n", f->filename,
f->loc.lp->start_line + f->loc.line);
i = f->inclusion_line;
f = f->included_by;
if (f == NULL) break;
error_printf (" Included at %s:%d\n", f->filename, i);
}
/* Show the line itself, taking care not to print more than what can
show up on the terminal. Tabs are converted to spaces. */
p = l->lp->line[l->line] + offset;
p = lb->line + offset;
i = strlen (p);
if (i > terminal_width)
i = terminal_width - 1;
......@@ -190,12 +196,12 @@ show_loci (locus * l1, locus * l2)
return;
}
c1 = l1->nextc - l1->lp->line[l1->line];
c1 = l1->nextc - l1->lb->line;
c2 = 0;
if (l2 == NULL)
goto separate;
c2 = l2->nextc - l2->lp->line[l2->line];
c2 = l2->nextc - l2->lb->line;
if (c1 < c2)
m = c2 - c1;
......@@ -203,7 +209,7 @@ show_loci (locus * l1, locus * l2)
m = c1 - c2;
if (l1->lp != l2->lp || l1->line != l2->line || m > terminal_width - 10)
if (l1->lb != l2->lb || m > terminal_width - 10)
goto separate;
offset = 0;
......
......@@ -413,35 +413,40 @@ typedef struct
symbol_attribute;
typedef struct
{
char *nextc;
int line; /* line within the lp structure */
struct linebuf *lp;
struct gfc_file *file;
}
locus;
/* The following three structures are used to identify a location in
the sources.
gfc_file is used to maintain a tree of the source files and how
they include each other
/* The linebuf structure deserves some explanation. This is the
primary structure for holding lines. A source file is stored in a
singly linked list of these structures. Each structure holds an
integer number of lines. The line[] member is actually an array of
pointers that point to the NULL-terminated lines. This list grows
upwards, and the actual lines are stored at the top of the
structure and grow downward. Each structure is packed with as many
lines as it can hold, then another linebuf is allocated. */
gfc_linebuf holds a single line of source code and information
which file it resides in
/* Chosen so that sizeof(linebuf) = 4096 on most machines */
#define LINEBUF_SIZE 4080
locus point to the sourceline and the character in the source
line.
*/
typedef struct linebuf
typedef struct gfc_file
{
int start_line, lines;
struct linebuf *next;
char *line[1];
char buf[LINEBUF_SIZE];
}
linebuf;
struct gfc_file *included_by, *next, *up;
int inclusion_line, line;
char *filename;
} gfc_file;
typedef struct gfc_linebuf
{
int linenum;
struct gfc_file *file;
struct gfc_linebuf *next;
char line[];
} gfc_linebuf;
typedef struct
{
char *nextc;
gfc_linebuf *lb;
} locus;
#include <limits.h>
......@@ -451,17 +456,6 @@ linebuf;
#endif
typedef struct gfc_file
{
char filename[PATH_MAX + 1];
gfc_source_form form;
struct gfc_file *included_by, *next;
locus loc;
struct linebuf *start;
}
gfc_file;
extern int gfc_suppress_error;
......@@ -1308,7 +1302,9 @@ void gfc_error_recovery (void);
void gfc_gobble_whitespace (void);
try gfc_new_file (const char *, gfc_source_form);
extern gfc_file *gfc_current_file;
extern gfc_source_form gfc_current_form;
extern char *gfc_source_file;
/* extern locus gfc_current_locus; */
/* misc.c */
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
......
......@@ -7,29 +7,29 @@ This file is licensed under the GPL. */
/* This is the contribution to the `default_compilers' array in gcc.c
for the f95 language. */
{".F", "@f77-cpp-input", 0},
{".fpp", "@f77-cpp-input", 0},
{".FPP", "@f77-cpp-input", 0},
{".F", "@f77-cpp-input", 0, 0, 0},
{".fpp", "@f77-cpp-input", 0, 0, 0},
{".FPP", "@f77-cpp-input", 0, 0, 0},
{"@f77-cpp-input",
"cc1 -P -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
"cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
%{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},
{".F90", "@f95-cpp-input", 0},
{".F95", "@f95-cpp-input", 0},
%{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
{".F90", "@f95-cpp-input", 0, 0, 0},
{".F95", "@f95-cpp-input", 0, 0, 0},
{"@f95-cpp-input",
"cc1 -P -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
"cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
%{E|M|MM:%(cpp_debug_options)}\
%{!M:%{!MM:%{!E: -o %|.f95 |\n\
f951 %|.f95 %(cc1_options) %{J*} %{I*}\
%{!fsyntax-only:%(invoke_as)}}}}", 0},
{".f90", "@f95", 0},
{".f95", "@f95", 0},
%{!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*}\
%{!fsyntax-only:%(invoke_as)}}", 0},
{".f", "@f77", 0},
{".for", "@f77", 0},
{".FOR", "@f77", 0},
%{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
{".f", "@f77", 0, 0, 0},
{".for", "@f77", 0, 0, 0},
{".FOR", "@f77", 0, 0, 0},
{"@f77", "%{!E:f951 %i %{!ffree-form:-ffixed-form} %(cc1_options) %{J*} %{I*}\
%{!fsyntax-only:%(invoke_as)}}", 0},
%{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
......@@ -77,7 +77,7 @@ gfc_match_space (void)
locus old_loc;
int c;
if (gfc_current_file->form == FORM_FIXED)
if (gfc_current_form == FORM_FIXED)
return MATCH_YES;
old_loc = *gfc_current_locus ();
......@@ -337,7 +337,7 @@ gfc_match_strings (mstring * a)
if (*p->mp == ' ')
{
/* Space matches 1+ whitespace(s). */
if ((gfc_current_file->form == FORM_FREE)
if ((gfc_current_form == FORM_FREE)
&& gfc_is_whitespace (c))
continue;
......
......@@ -3338,7 +3338,6 @@ void
gfc_dump_module (const char *name, int dump_flag)
{
char filename[PATH_MAX], *p;
gfc_file *g;
time_t now;
filename[0] = '\0';
......@@ -3359,17 +3358,13 @@ gfc_dump_module (const char *name, int dump_flag)
gfc_fatal_error ("Can't open module file '%s' for writing: %s",
filename, strerror (errno));
/* Find the top level filename. */
g = gfc_current_file;
while (g->next)
g = g->next;
now = time (NULL);
p = ctime (&now);
*strchr (p, '\n') = '\0';
fprintf (module_fp, "GFORTRAN module created from %s on %s\n", g->filename, p);
fprintf (module_fp, "GFORTRAN module created from %s on %s\n",
gfc_source_file, p);
fputs ("If you edit this, you'll get what you deserve.\n\n", module_fp);
iomode = IO_OUTPUT;
......
......@@ -483,16 +483,6 @@ next_statement (void)
gfc_skip_comments ();
if (gfc_at_bol () && gfc_check_include ())
continue;
if (gfc_at_eof () && gfc_current_file->included_by != NULL)
{
gfc_current_file = gfc_current_file->included_by;
gfc_advance_line ();
continue;
}
if (gfc_at_end ())
{
st = ST_NONE;
......@@ -500,7 +490,8 @@ next_statement (void)
}
st =
(gfc_current_file->form == FORM_FIXED) ? next_fixed () : next_free ();
(gfc_current_form == FORM_FIXED) ? next_fixed () : next_free ();
if (st != ST_NONE)
break;
}
......@@ -1268,7 +1259,7 @@ unexpected_eof (void)
{
gfc_state_data *p;
gfc_error ("Unexpected end of file in '%s'", gfc_current_file->filename);
gfc_error ("Unexpected end of file in '%s'", gfc_source_file);
/* Memory cleanup. Move to "second to last". */
for (p = gfc_state_stack; p && p->previous && p->previous->previous;
......
......@@ -244,8 +244,8 @@ gfc_get_label_decl (gfc_st_label * lp)
/* Tell the debugger where the label came from. */
if (lp->value <= MAX_LABEL_VALUE) /* An internal label */
{
DECL_SOURCE_LINE (label_decl) = lp->where.line;
DECL_SOURCE_FILE (label_decl) = lp->where.file->filename;
DECL_SOURCE_LINE (label_decl) = lp->where.lb->linenum;
DECL_SOURCE_FILE (label_decl) = lp->where.lb->file->filename;
}
else
DECL_ARTIFICIAL (label_decl) = 1;
......
......@@ -500,13 +500,13 @@ set_error_locus (stmtblock_t * block, locus * where)
tree tmp;
int line;
f = where->file;
f = where->lb->file;
tmp = gfc_build_string_const (strlen (f->filename) + 1, f->filename);
tmp = gfc_build_addr_expr (pchar_type_node, tmp);
gfc_add_modify_expr (block, locus_file, tmp);
line = where->lp->start_line + where->line;
line = where->lb->linenum;
gfc_add_modify_expr (block, locus_line, build_int_2 (line, 0));
}
......
......@@ -414,8 +414,9 @@ gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append)
void
gfc_get_backend_locus (locus * loc)
{
loc->line = input_line - 1;
loc->file = gfc_current_backend_file;
loc->lb = gfc_getmem (sizeof (gfc_linebuf));
loc->lb->linenum = input_line - 1;
loc->lb->file = gfc_current_backend_file;
}
......@@ -424,9 +425,9 @@ gfc_get_backend_locus (locus * loc)
void
gfc_set_backend_locus (locus * loc)
{
input_line = loc->line + 1;
gfc_current_backend_file = loc->file;
input_filename = loc->file->filename;
input_line = loc->lb->linenum;
gfc_current_backend_file = loc->lb->file;
input_filename = loc->lb->file->filename;
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment