Commit e0bcf78c by Tobias Schlüter Committed by Tobias Schlüter

gfortran.h (gfc_option_t): Remove source field.

fortran/
	* gfortran.h (gfc_option_t): Remove source field.  Add
	flag_d_lines field.
	(gfc_new_file): Remove arguments in prototype.
	(gfc_source_file): Make 'const char *'.
	* f95-lang.c (gfc_init): Use gfc_source_file instead of
	gfc_option.source.  Call gfc_new_file without arguments.
	* invoke.texi: Document new options '-fd-lines-as-code' and
	'-fd-lines-as-comment'.
	* lang.opt: Add new options.  Alphabetize.
	* options.c (gfc_init_options): Initialize gfc_source_file instead
	of gfc_option.source.  Initialize gfc_option.flag_d_lines.
	(form_from_filename): Move here from scanner.c.  Make
	'filename' argument 'const'.
	(gfc_post_options): Set gfc_source_file.  Determine source form.
	Warn if 'd-lines*' are used in free form.
	* scanner.c (gfc_source_file): Constify.
	(skip_fixed_comments): Deal with d-lines.
	(get_file): Constify argument 'name'.
	(load_file): Constify argument 'filename'.
	(form_from_filename): Moved to options.c.
	(gfc_new_file): Remove arguments.  Don't initialize
	gfc_source_file, don't determine source form.
	* trans-const.c (gfc_init_constants): Use gfc_source_file instead
	of gfc_option.source.

testsuite/
	* d_lines_1.f, d_lines_2.f, d_lines_3.f, d_lines_4.f,
	d_lines_5.f: New.

From-SVN: r103322
parent 1125164c
2005-08-21 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.h (gfc_option_t): Remove source field. Add
flag_d_lines field.
(gfc_new_file): Remove arguments in prototype.
(gfc_source_file): Make 'const char *'.
* f95-lang.c (gfc_init): Use gfc_source_file instead of
gfc_option.source. Call gfc_new_file without arguments.
* invoke.texi: Document new options '-fd-lines-as-code' and
'-fd-lines-as-comment'.
* lang.opt: Add new options. Alphabetize.
* options.c (gfc_init_options): Initialize gfc_source_file instead
of gfc_option.source. Initialize gfc_option.flag_d_lines.
(form_from_filename): Move here from scanner.c. Make
'filename' argument 'const'.
(gfc_post_options): Set gfc_source_file. Determine source form.
Warn if 'd-lines*' are used in free form.
* scanner.c (gfc_source_file): Constify.
(skip_fixed_comments): Deal with d-lines.
(get_file): Constify argument 'name'.
(load_file): Constify argument 'filename'.
(form_from_filename): Moved to options.c.
(gfc_new_file): Remove arguments. Don't initialize
gfc_source_file, don't determine source form.
* trans-const.c (gfc_init_constants): Use gfc_source_file instead
of gfc_option.source.
2005-08-19 Steven G. Kargl <kargls@comcast.net> 2005-08-19 Steven G. Kargl <kargls@comcast.net>
PR fortran/23065 PR fortran/23065
......
...@@ -271,7 +271,7 @@ static bool ...@@ -271,7 +271,7 @@ static bool
gfc_init (void) gfc_init (void)
{ {
#ifdef USE_MAPPED_LOCATION #ifdef USE_MAPPED_LOCATION
linemap_add (&line_table, LC_ENTER, false, gfc_option.source, 1); linemap_add (&line_table, LC_ENTER, false, gfc_source_file, 1);
linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0); linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
#endif #endif
...@@ -282,8 +282,8 @@ gfc_init (void) ...@@ -282,8 +282,8 @@ gfc_init (void)
/* Then the frontend. */ /* Then the frontend. */
gfc_init_1 (); gfc_init_1 ();
if (gfc_new_file (gfc_option.source, gfc_option.source_form) != SUCCESS) if (gfc_new_file () != SUCCESS)
fatal_error ("can't open input file: %s", gfc_option.source); fatal_error ("can't open input file: %s", gfc_source_file);
return true; return true;
} }
......
...@@ -1407,7 +1407,6 @@ gfc_data; ...@@ -1407,7 +1407,6 @@ gfc_data;
/* Structure for holding compile options */ /* Structure for holding compile options */
typedef struct typedef struct
{ {
const char *source;
char *module_dir; char *module_dir;
gfc_source_form source_form; gfc_source_form source_form;
int fixed_line_length; int fixed_line_length;
...@@ -1436,6 +1435,7 @@ typedef struct ...@@ -1436,6 +1435,7 @@ typedef struct
int flag_repack_arrays; int flag_repack_arrays;
int flag_f2c; int flag_f2c;
int flag_backslash; int flag_backslash;
int flag_d_lines;
int q_kind; int q_kind;
...@@ -1507,10 +1507,10 @@ int gfc_next_char (void); ...@@ -1507,10 +1507,10 @@ int gfc_next_char (void);
int gfc_peek_char (void); int gfc_peek_char (void);
void gfc_error_recovery (void); void gfc_error_recovery (void);
void gfc_gobble_whitespace (void); void gfc_gobble_whitespace (void);
try gfc_new_file (const char *, gfc_source_form); try gfc_new_file (void);
extern gfc_source_form gfc_current_form; extern gfc_source_form gfc_current_form;
extern char *gfc_source_file; extern const char *gfc_source_file;
extern locus gfc_current_locus; extern locus gfc_current_locus;
/* misc.c */ /* misc.c */
......
...@@ -117,7 +117,7 @@ by type. Explanations are in the following sections. ...@@ -117,7 +117,7 @@ by type. Explanations are in the following sections.
@gccoptlist{ @gccoptlist{
-ffree-form -fno-fixed-form @gol -ffree-form -fno-fixed-form @gol
-fdollar-ok -fimplicit-none -fmax-identifier-length @gol -fdollar-ok -fimplicit-none -fmax-identifier-length @gol
-std=@var{std} -std=@var{std} -fd-lines-as-code -fd-lines-as-comments @gol
-ffixed-line-length-@var{n} -ffixed-line-length-none @gol -ffixed-line-length-@var{n} -ffixed-line-length-none @gol
-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 } -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 }
...@@ -183,6 +183,18 @@ Specify the layout used by the source file. The free form layout ...@@ -183,6 +183,18 @@ Specify the layout used by the source file. The free form layout
was introduced in Fortran 90. Fixed form was traditionally used in was introduced in Fortran 90. Fixed form was traditionally used in
older Fortran programs. older Fortran programs.
@cindex option, -fd-lines-as-code
@cindex -fd-lines-as-code, option
@cindex option, -fd-lines-as-comments
@cindex -fd-lines-as-comments, option
@item -fd-lines-as-code
@item -fd-lines-as-comment
Enables special treating for lines with @samp{d} or @samp{D} in fixed
form sources. If the @option{-fd-lines-as-code} option is given
they are treated as if the first column contained a blank. If the
@option{-fd-lines-as-comments} option is given, they are treated as
comment lines.
@cindex option, -fdefault-double-8 @cindex option, -fdefault-double-8
@cindex -fdefault-double-8, option @cindex -fdefault-double-8, option
@item -fdefault-double-8 @item -fdefault-double-8
......
...@@ -69,6 +69,10 @@ Wunused-labels ...@@ -69,6 +69,10 @@ Wunused-labels
F95 F95
Warn when a label is unused Warn when a label is unused
fbackslash
F95
Specify that backslash in string introduces an escape character
fdefault-double-8 fdefault-double-8
F95 F95
Set the default double precision kind to an 8 byte wide type Set the default double precision kind to an 8 byte wide type
...@@ -81,14 +85,18 @@ fdefault-real-8 ...@@ -81,14 +85,18 @@ fdefault-real-8
F95 F95
Set the default real kind to an 8 byte wide type Set the default real kind to an 8 byte wide type
fd-lines-as-code
F95 RejectNegative
Ignore 'D' in column one in fixed form
fd-lines-as-comments
F95 RejectNegative
Treat lines with 'D' in column one as comments
fdollar-ok fdollar-ok
F95 F95
Allow dollar signs in entity names Allow dollar signs in entity names
fbackslash
F95
Specify that backslash in string introduces an escape character
fdump-parse-tree fdump-parse-tree
F95 F95
Display the code tree after parsing Display the code tree after parsing
......
...@@ -42,7 +42,7 @@ unsigned int ...@@ -42,7 +42,7 @@ unsigned int
gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
const char **argv ATTRIBUTE_UNUSED) const char **argv ATTRIBUTE_UNUSED)
{ {
gfc_option.source = NULL; gfc_source_file = NULL;
gfc_option.module_dir = NULL; gfc_option.module_dir = NULL;
gfc_option.source_form = FORM_UNKNOWN; gfc_option.source_form = FORM_UNKNOWN;
gfc_option.fixed_line_length = 72; gfc_option.fixed_line_length = 72;
...@@ -71,6 +71,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, ...@@ -71,6 +71,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.flag_pack_derived = 0; gfc_option.flag_pack_derived = 0;
gfc_option.flag_repack_arrays = 0; gfc_option.flag_repack_arrays = 0;
gfc_option.flag_backslash = 1; gfc_option.flag_backslash = 1;
gfc_option.flag_d_lines = -1;
gfc_option.q_kind = gfc_default_double_kind; gfc_option.q_kind = gfc_default_double_kind;
...@@ -89,6 +90,74 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, ...@@ -89,6 +90,74 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
} }
/* Determine the source form from the filename extension. We assume
case insensitivity. */
static gfc_source_form
form_from_filename (const char *filename)
{
static const struct
{
const char *extension;
gfc_source_form form;
}
exttype[] =
{
{
".f90", FORM_FREE}
,
{
".f95", FORM_FREE}
,
{
".f", FORM_FIXED}
,
{
".for", FORM_FIXED}
,
{
"", FORM_UNKNOWN}
}; /* sentinel value */
gfc_source_form f_form;
const char *fileext;
int i;
/* Find end of file name. Note, filename is either a NULL pointer or
a NUL terminated string. */
i = 0;
while (filename[i] != '\0')
i++;
/* Find last period. */
while (i >= 0 && (filename[i] != '.'))
i--;
/* Did we see a file extension? */
if (i < 0)
return FORM_UNKNOWN; /* Nope */
/* Get file extension and compare it to others. */
fileext = &(filename[i]);
i = -1;
f_form = FORM_UNKNOWN;
do
{
i++;
if (strcasecmp (fileext, exttype[i].extension) == 0)
{
f_form = exttype[i].form;
break;
}
}
while (exttype[i].form != FORM_UNKNOWN);
return f_form;
}
/* Finalize commandline options. */ /* Finalize commandline options. */
bool bool
...@@ -102,7 +171,35 @@ gfc_post_options (const char **pfilename) ...@@ -102,7 +171,35 @@ gfc_post_options (const char **pfilename)
filename = ""; filename = "";
} }
gfc_option.source = filename; gfc_source_file = filename;
/* Decide which form the file will be read in as. */
if (gfc_option.source_form != FORM_UNKNOWN)
gfc_current_form = gfc_option.source_form;
else
{
gfc_current_form = form_from_filename (filename);
if (gfc_current_form == FORM_UNKNOWN)
{
gfc_current_form = FORM_FREE;
gfc_warning_now ("Reading file '%s' as free form.",
(filename[0] == '\0') ? "<stdin>" : filename);
}
}
/* If the user specified -fd-lines-as-{code|comments} verify that we're
in fixed form. */
if (gfc_current_form == FORM_FREE)
{
if (gfc_option.flag_d_lines == 0)
gfc_warning_now ("'-fd-lines-as-comments' has no effect "
"in free form.");
else if (gfc_option.flag_d_lines == 1)
gfc_warning_now ("'-fd-lines-as-code' has no effect "
"in free form.");
}
flag_inline_trees = 1; flag_inline_trees = 1;
...@@ -238,6 +335,14 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -238,6 +335,14 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.flag_backslash = value; gfc_option.flag_backslash = value;
break; break;
case OPT_fd_lines_as_code:
gfc_option.flag_d_lines = 1;
break;
case OPT_fd_lines_as_comments:
gfc_option.flag_d_lines = 0;
break;
case OPT_fdump_parse_tree: case OPT_fdump_parse_tree:
gfc_option.verbose = value; gfc_option.verbose = value;
break; break;
......
...@@ -65,7 +65,7 @@ gfc_source_form gfc_current_form; ...@@ -65,7 +65,7 @@ gfc_source_form gfc_current_form;
static gfc_linebuf *line_head, *line_tail; static gfc_linebuf *line_head, *line_tail;
locus gfc_current_locus; locus gfc_current_locus;
char *gfc_source_file; const char *gfc_source_file;
/* Main scanner initialization. */ /* Main scanner initialization. */
...@@ -355,7 +355,8 @@ skip_free_comments (void) ...@@ -355,7 +355,8 @@ skip_free_comments (void)
/* Skip comment lines in fixed source mode. We have the same rules as /* Skip comment lines in fixed source mode. We have the same rules as
in skip_free_comment(), except that we can have a 'c', 'C' or '*' in skip_free_comment(), except that we can have a 'c', 'C' or '*'
in column 1, and a '!' cannot be in column 6. */ in column 1, and a '!' cannot be in column 6. Also, we deal with
lines with 'd' or 'D' in column 1, if the user requested this. */
static void static void
skip_fixed_comments (void) skip_fixed_comments (void)
...@@ -383,13 +384,24 @@ skip_fixed_comments (void) ...@@ -383,13 +384,24 @@ skip_fixed_comments (void)
continue; continue;
} }
if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
{
if (gfc_option.flag_d_lines == 0)
{
skip_comment_line ();
continue;
}
else
*start.nextc = c = ' ';
}
col = 1; col = 1;
do
while (gfc_is_whitespace (c))
{ {
c = next_char (); c = next_char ();
col++; col++;
} }
while (gfc_is_whitespace (c));
if (c == '\n') if (c == '\n')
{ {
...@@ -796,7 +808,7 @@ load_line (FILE * input, char **pbuf, int *pbuflen) ...@@ -796,7 +808,7 @@ load_line (FILE * input, char **pbuf, int *pbuflen)
the file stack. */ the file stack. */
static gfc_file * static gfc_file *
get_file (char *name, enum lc_reason reason ATTRIBUTE_UNUSED) get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
{ {
gfc_file *f; gfc_file *f;
...@@ -938,7 +950,7 @@ preprocessor_line (char *c) ...@@ -938,7 +950,7 @@ preprocessor_line (char *c)
} }
static try load_file (char *, bool); static try load_file (const char *, bool);
/* include_line()-- Checks a line buffer to see if it is an include /* 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 line. If so, we call load_file() recursively to load the included
...@@ -996,7 +1008,7 @@ include_line (char *line) ...@@ -996,7 +1008,7 @@ include_line (char *line)
/* Load a file into memory by calling load_line until the file ends. */ /* Load a file into memory by calling load_line until the file ends. */
static try static try
load_file (char *filename, bool initial) load_file (const char *filename, bool initial)
{ {
char *line; char *line;
gfc_linebuf *b; gfc_linebuf *b;
...@@ -1097,108 +1109,16 @@ load_file (char *filename, bool initial) ...@@ -1097,108 +1109,16 @@ load_file (char *filename, bool initial)
} }
/* Determine the source form from the filename extension. We assume
case insensitivity. */
static gfc_source_form
form_from_filename (const char *filename)
{
static const struct
{
const char *extension;
gfc_source_form form;
}
exttype[] =
{
{
".f90", FORM_FREE}
,
{
".f95", FORM_FREE}
,
{
".f", FORM_FIXED}
,
{
".for", FORM_FIXED}
,
{
"", FORM_UNKNOWN}
}; /* sentinel value */
gfc_source_form f_form;
const char *fileext;
int i;
/* Find end of file name. Note, filename is either a NULL pointer or
a NUL terminated string. */
i = 0;
while (filename[i] != '\0')
i++;
/* Find last period. */
while (i >= 0 && (filename[i] != '.'))
i--;
/* Did we see a file extension? */
if (i < 0)
return FORM_UNKNOWN; /* Nope */
/* Get file extension and compare it to others. */
fileext = &(filename[i]);
i = -1;
f_form = FORM_UNKNOWN;
do
{
i++;
if (strcasecmp (fileext, exttype[i].extension) == 0)
{
f_form = exttype[i].form;
break;
}
}
while (exttype[i].form != FORM_UNKNOWN);
return f_form;
}
/* Open a new file and start scanning from that file. Returns 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_UKNOWN
it tries to determine the source form from the filename, defaulting it tries to determine the source form from the filename, defaulting
to free form. */ to free form. */
try try
gfc_new_file (const char *filename, gfc_source_form form) gfc_new_file (void)
{ {
try result; try result;
if (filename != NULL)
{
gfc_source_file = gfc_getmem (strlen (filename) + 1);
strcpy (gfc_source_file, filename);
}
else
gfc_source_file = NULL;
/* Decide which form the file will be read in as. */
if (form != FORM_UNKNOWN)
gfc_current_form = form;
else
{
gfc_current_form = form_from_filename (filename);
if (gfc_current_form == FORM_UNKNOWN)
{
gfc_current_form = FORM_FREE;
gfc_warning_now ("Reading file '%s' as free form.",
(filename[0] == '\0') ? "<stdin>" : filename);
}
}
result = load_file (gfc_source_file, true); result = load_file (gfc_source_file, true);
gfc_current_locus.lb = line_head; gfc_current_locus.lb = line_head;
......
...@@ -163,7 +163,7 @@ gfc_init_constants (void) ...@@ -163,7 +163,7 @@ gfc_init_constants (void)
gfc_build_cstring_const ("Incorrect function return value"); gfc_build_cstring_const ("Incorrect function return value");
gfc_strconst_current_filename = gfc_strconst_current_filename =
gfc_build_cstring_const (gfc_option.source); gfc_build_cstring_const (gfc_source_file);
} }
/* Converts a GMP integer into a backend tree node. */ /* Converts a GMP integer into a backend tree node. */
......
2005-08-21 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
* d_lines_1.f, d_lines_2.f, d_lines_3.f, d_lines_4.f,
d_lines_5.f: New.
2005-08-21 Jakub Jelinek <jakub@redhat.com> 2005-08-21 Jakub Jelinek <jakub@redhat.com>
* gcc.target/i386/sse-4.c: New test. * gcc.target/i386/sse-4.c: New test.
......
! { dg-do compile }
! { dg-options "-fd-lines-as-comments" }
d This is a comment.
D This line, too.
end
! { dg-do compile }
c { dg-options "-fd-lines-as-code" }
i = 0
d end
subroutine s
D end
C { dg-do compile }
C { dg-options "-fd-lines-as-code" }
C Verifies that column numbers are dealt with correctly when handling D lines.
C234567890
d i = 0 ! this may not move to the left
d 1 + 1 ! this should be a continuation line
goto 2345
d23450continue ! statement labels are correctly identified
end
! { dg-do compile }
c verify that debug lines are rejected if none of -fd-lines-as-* are given.
d ! { dg-error "Non-numeric character" }
! { dg-do compile }
c { dg-options "-fd-lines-as-code" }
d ! This didn't work in an early version of the support for -fd-lines*
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