[PATCH] Fortran include line fixes and -fdec-include support
Jakub Jelinek
jakub@redhat.com
Mon Nov 12 14:51:00 GMT 2018
Hi!
In fortran97.pdf I read:
"Except in a character context, blanks are insignificant and may be used freely throughout the program."
and while we handle that in most cases, we don't allow spaces in INCLUDE
lines in fixed form, while e.g. ifort does.
Another thing, which I haven't touched in the PR except covering it with a
testcase is that we allow INLINE line in fixed form to start even in columns
1 to 6, while ifort rejects that. Is say
include 'omp_lib.h'
valid in fixed form? i in column 6 normally means a continuation line,
though not sure if anything can in a valid program contain nclude
followed by character literal. Shall we reject that, or at least warn that
it won't be portable?
The last thing, biggest part of the patch, is that for legacy DEC
compatibility, the DEC manuals document INCLUDE as a statement, not a line,
the
"An INCLUDE line is not a Fortran statement."
and
"An INCLUDE line shall appear on a single source line where a statement may appear; it shall be
the only nonblank text on this line other than an optional trailing comment. Thus, a statement
label is not allowed."
bullets don't apply, but instead there is:
"The INCLUDE statement takes one of the following forms:"
"An INCLUDE statement can appear anywhere within a scoping unit. The statement
can span more than one source line, but no other statement can appear on the same
line. The source line cannot be labeled."
This means there can be (as can be seen in the following testcases)
continuations in both forms, and in fixed form there can be 0 in column 6.
In order not to duplicate all the handling of continuations, comment
skipping etc., the patch just adjusts the include_line routine so that it
signals if the current line is a possible start of a valid INCLUDE statement
when in -fdec-include mode, and if so, whenever it reads a further line it
retries to parse it using
gfc_next_char/gfc_next_char_literal/gfc_gobble_whitespace APIs as an INCLUDE
stmt. If it is found not to be a valid INCLUDE statement line or set of
lines, it returns 0, if it is valid, it returns 1 together with load_file
like include_line does and clears all the lines containint the INCLUDE
statement. If the reading stops because we don't have enough lines, -1 is
returned and the caller tries again with more lines.
Tested on x86_64-linux, ok for trunk if it passes full bootstrap/regtest?
In addition to the above mentioned question about include in columns 1-6 in
fixed form, another thing is that we support
print *, 'abc''def'
print *, "hij""klm"
which prints abc'def and hij"klm. Shall we support that for INCLUDE lines
and INCLUDE statements too?
2018-11-12 Jakub Jelinek <jakub@redhat.com>
Mark Eggleston <mark.eggleston@codethink.com>
* lang.opt (fdec-include): New option.
* options.c (set_dec_flags): Set also flag_dec_include.
* scanner.c (include_line): Change return type from bool to int.
In fixed form allow spaces in between include keyword letters.
For -fdec-include, allow in fixed form 0 in column 6. With
-fdec-include return -1 if the parsed line is not full include
statement and it could be successfully completed on continuation
lines.
(include_stmt): New function.
(load_file): Adjust include_line caller. If it returns -1, keep
trying include_stmt until it stops returning -1 whenever adding
further line of input.
* gfortran.dg/include_10.f: New test.
* gfortran.dg/include_10.inc: New file.
* gfortran.dg/include_11.f: New test.
* gfortran.dg/include_12.f: New test.
* gfortran.dg/include_13.f90: New test.
* gfortran.dg/gomp/include_1.f: New test.
* gfortran.dg/gomp/include_1.inc: New file.
* gfortran.dg/gomp/include_2.f90: New test.
--- gcc/fortran/lang.opt.jj 2018-07-18 22:57:15.227785894 +0200
+++ gcc/fortran/lang.opt 2018-11-12 09:35:03.185259773 +0100
@@ -440,6 +440,10 @@ fdec
Fortran Var(flag_dec)
Enable all DEC language extensions.
+fdec-include
+Fortran Var(flag_dec_include)
+Enable legacy parsing of INCLUDE as statement.
+
fdec-intrinsic-ints
Fortran Var(flag_dec_intrinsic_ints)
Enable kind-specific variants of integer intrinsic functions.
--- gcc/fortran/options.c.jj 2018-11-06 18:27:13.828831733 +0100
+++ gcc/fortran/options.c 2018-11-12 09:35:39.515655453 +0100
@@ -68,6 +68,7 @@ set_dec_flags (int value)
flag_dec_intrinsic_ints |= value;
flag_dec_static |= value;
flag_dec_math |= value;
+ flag_dec_include |= value;
}
--- gcc/fortran/scanner.c.jj 2018-05-08 13:56:41.691932534 +0200
+++ gcc/fortran/scanner.c 2018-11-12 15:21:51.249391936 +0100
@@ -2135,14 +2135,18 @@ static bool load_file (const char *, con
/* 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
file. We never return a syntax error because a statement like
- "include = 5" is perfectly legal. We return false if no include was
- processed or true if we matched an include. */
+ "include = 5" is perfectly legal. We return 0 if no include was
+ processed, 1 if we matched an include or -1 if include was
+ partially processed, but will need continuation lines. */
-static bool
+static int
include_line (gfc_char_t *line)
{
gfc_char_t quote, *c, *begin, *stop;
char *filename;
+ const char *include = "include";
+ bool allow_continuation = flag_dec_include;
+ int i;
c = line;
@@ -2158,42 +2162,133 @@ include_line (gfc_char_t *line)
else
{
if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
- && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
+ && c[1] == '$' && c[2] == ' ')
c += 3;
}
}
- while (*c == ' ' || *c == '\t')
- c++;
+ if (gfc_current_form == FORM_FREE)
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (gfc_wide_strncasecmp (c, "include", 7))
+ {
+ if (!allow_continuation)
+ return 0;
+ for (i = 0; i < 7; ++i)
+ {
+ gfc_char_t c1 = gfc_wide_tolower (*c);
+ if (c1 != (unsigned char) include[i])
+ break;
+ c++;
+ }
+ if (i == 0 || *c != '&')
+ return 0;
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (*c == '\0' || *c == '!')
+ return -1;
+ return 0;
+ }
+
+ c += 7;
+ }
+ else
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (flag_dec_include && *c == '0' && c - line == 5)
+ {
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ }
+ if (c - line < 6)
+ allow_continuation = false;
+ for (i = 0; i < 7; ++i)
+ {
+ gfc_char_t c1 = gfc_wide_tolower (*c);
+ if (c1 != (unsigned char) include[i])
+ break;
+ c++;
+ while (*c == ' ' || *c == '\t')
+ c++;
+ }
+ if (!allow_continuation)
+ {
+ if (i != 7)
+ return 0;
+ }
+ else if (i != 7)
+ {
+ if (i == 0)
+ return 0;
- if (gfc_wide_strncasecmp (c, "include", 7))
- return false;
+ /* At the end of line or comment this might be continued. */
+ if (*c == '\0' || *c == '!')
+ return -1;
+
+ return 0;
+ }
+ }
- c += 7;
while (*c == ' ' || *c == '\t')
c++;
/* Find filename between quotes. */
-
+
quote = *c++;
if (quote != '"' && quote != '\'')
- return false;
+ {
+ if (allow_continuation)
+ {
+ if (gfc_current_form == FORM_FREE)
+ {
+ if (quote == '&')
+ {
+ while (*c == ' ' || *c == '\t')
+ c++;
+ if (*c == '\0' || *c == '!')
+ return -1;
+ }
+ }
+ else if (quote == '\0' || quote == '!')
+ return -1;
+ }
+ return 0;
+ }
begin = c;
+ bool cont = false;
while (*c != quote && *c != '\0')
- c++;
+ {
+ if (allow_continuation && gfc_current_form == FORM_FREE)
+ {
+ if (*c == '&')
+ cont = true;
+ else if (*c != ' ' && *c != '\t')
+ cont = false;
+ }
+ c++;
+ }
if (*c == '\0')
- return false;
+ {
+ if (allow_continuation
+ && (cont || gfc_current_form != FORM_FREE))
+ return -1;
+ return 0;
+ }
stop = c++;
-
+
while (*c == ' ' || *c == '\t')
c++;
if (*c != '\0' && *c != '!')
- return false;
+ return 0;
/* We have an include line at this point. */
@@ -2205,9 +2300,130 @@ include_line (gfc_char_t *line)
exit (FATAL_EXIT_CODE);
free (filename);
- return true;
+ return 1;
}
+/* Similarly, but try to parse an INCLUDE statement, using gfc_next_char etc.
+ APIs. Return 1 if recognized as valid INCLUDE statement and load_file has
+ been called, 0 if it is not a valid INCLUDE statement and -1 if eof has
+ been encountered while parsing it. */
+static int
+include_stmt (gfc_linebuf *b)
+{
+ int ret = 0, i, length;
+ const char *include = "include";
+ gfc_char_t c, quote = 0;
+ locus str_locus;
+ char *filename;
+
+ continue_flag = 0;
+ end_flag = 0;
+ gcc_attribute_flag = 0;
+ openmp_flag = 0;
+ openacc_flag = 0;
+ continue_count = 0;
+ continue_line = 0;
+ gfc_current_locus.lb = b;
+ gfc_current_locus.nextc = b->line;
+
+ gfc_skip_comments ();
+ gfc_gobble_whitespace ();
+
+ for (i = 0; i < 7; i++)
+ {
+ c = gfc_next_char ();
+ if (c != (unsigned char) include[i])
+ {
+ if (gfc_current_form == FORM_FIXED
+ && i == 0
+ && c == '0'
+ && gfc_current_locus.nextc == b->line + 6)
+ {
+ gfc_gobble_whitespace ();
+ i--;
+ continue;
+ }
+ gcc_assert (i != 0);
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ }
+ goto do_ret;
+ }
+ }
+ gfc_gobble_whitespace ();
+
+ c = gfc_next_char ();
+ if (c == '\'' || c == '"')
+ quote = c;
+ else
+ {
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ }
+ goto do_ret;
+ }
+
+ str_locus = gfc_current_locus;
+ length = 0;
+ do
+ {
+ c = gfc_next_char_literal (INSTRING_NOWARN);
+ if (c == quote)
+ break;
+ if (c == '\n')
+ {
+ gfc_advance_line ();
+ gfc_skip_comments ();
+ if (gfc_at_eof ())
+ ret = -1;
+ goto do_ret;
+ }
+ length++;
+ }
+ while (1);
+
+ gfc_gobble_whitespace ();
+ c = gfc_next_char ();
+ if (c != '\n')
+ goto do_ret;
+
+ gfc_current_locus = str_locus;
+ ret = 1;
+ filename = XNEWVEC (char, length + 1);
+ for (i = 0; i < length; i++)
+ {
+ c = gfc_next_char_literal (INSTRING_WARN);
+ gcc_assert (gfc_wide_fits_in_byte (c));
+ filename[i] = (unsigned char) c;
+ }
+ filename[length] = '\0';
+ if (!load_file (filename, NULL, false))
+ exit (FATAL_EXIT_CODE);
+
+ free (filename);
+
+do_ret:
+ continue_flag = 0;
+ end_flag = 0;
+ gcc_attribute_flag = 0;
+ openmp_flag = 0;
+ openacc_flag = 0;
+ continue_count = 0;
+ continue_line = 0;
+ memset (&gfc_current_locus, '\0', sizeof (locus));
+ memset (&openmp_locus, '\0', sizeof (locus));
+ memset (&openacc_locus, '\0', sizeof (locus));
+ memset (&gcc_attribute_locus, '\0', sizeof (locus));
+ return ret;
+}
/* Load a file into memory by calling load_line until the file ends. */
@@ -2215,7 +2431,7 @@ static bool
load_file (const char *realfilename, const char *displayedname, bool initial)
{
gfc_char_t *line;
- gfc_linebuf *b;
+ gfc_linebuf *b, *include_b = NULL;
gfc_file *f;
FILE *input;
int len, line_len;
@@ -2318,6 +2534,7 @@ load_file (const char *realfilename, con
for (;;)
{
int trunc = load_line (input, &line, &line_len, NULL);
+ int inc_line;
len = gfc_wide_strlen (line);
if (feof (input) && len == 0)
@@ -2366,11 +2583,12 @@ load_file (const char *realfilename, con
}
/* Preprocessed files have preprocessor lines added before the byte
- order mark, so first_line is not about the first line of the file
+ order mark, so first_line is not about the first line of the file
but the first line that's not a preprocessor line. */
first_line = false;
- if (include_line (line))
+ inc_line = include_line (line);
+ if (inc_line > 0)
{
current_file->line++;
continue;
@@ -2403,6 +2621,36 @@ load_file (const char *realfilename, con
while (file_changes_cur < file_changes_count)
file_changes[file_changes_cur++].lb = b;
+
+ if (flag_dec_include)
+ {
+ if (include_b && b != include_b)
+ {
+ int inc_line2 = include_stmt (include_b);
+ if (inc_line2 == 0)
+ include_b = NULL;
+ else if (inc_line2 > 0)
+ {
+ do
+ {
+ if (gfc_current_form == FORM_FIXED)
+ {
+ for (gfc_char_t *p = include_b->line; *p; p++)
+ *p = ' ';
+ }
+ else
+ include_b->line[0] = '\0';
+ if (include_b == b)
+ break;
+ include_b = include_b->next;
+ }
+ while (1);
+ include_b = NULL;
+ }
+ }
+ if (inc_line == -1 && !include_b)
+ include_b = b;
+ }
}
/* Release the line buffer allocated in load_line. */
--- gcc/testsuite/gfortran.dg/include_10.f.jj 2018-11-12 12:21:50.886637849 +0100
+++ gcc/testsuite/gfortran.dg/include_10.f 2018-11-12 12:10:22.115007990 +0100
@@ -0,0 +1,11 @@
+c { dg-do compile }
+ subroutine foo
+ implicit none
+ include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i n cl UD e'include_10.inc'
+ i = 1
+ end subroutine bar
--- gcc/testsuite/gfortran.dg/include_10.inc.jj 2018-11-12 12:21:53.946587330 +0100
+++ gcc/testsuite/gfortran.dg/include_10.inc 2018-11-12 12:07:29.694854414 +0100
@@ -0,0 +1 @@
+ integer i
--- gcc/testsuite/gfortran.dg/include_11.f.jj 2018-11-12 12:38:34.883081270 +0100
+++ gcc/testsuite/gfortran.dg/include_11.f 2018-11-12 12:38:28.239190805 +0100
@@ -0,0 +1,20 @@
+c { dg-do compile }
+ subroutine foo
+ implicit none
+c We used to accept following in fixed mode. Shall we at least
+c warn about it?
+include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+c Likewise here.
+ implicit none
+ include'include_10.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+c And here.
+ implicit none
+ include 'include_10.inc'
+ i = 1
+ end subroutine baz
--- gcc/testsuite/gfortran.dg/include_12.f.jj 2018-11-12 14:36:42.542803497 +0100
+++ gcc/testsuite/gfortran.dg/include_12.f 2018-11-12 14:45:36.201055286 +0100
@@ -0,0 +1,49 @@
+c { dg-do compile }
+c { dg-options "-fdec-include" }
+ subroutine foo
+ implicit none
+ 0include 'include_10.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i
+ ;n
+ +c
+
+c some comment
+
+ ll
+C comment line
+ uu
+ DD
+ ee'include_10.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+ implicit none
+ 0include
+ + 'include_10.inc'
+ i = 1
+ end subroutine baz
+ subroutine qux
+ implicit none
+ i n C lude 'inc
+* another comment line
+ &lude_10.inc'
+ i = 1
+ end subroutine qux
+ subroutine quux
+ implicit none
+ 0inc
+ 1lud
+ 2e '
+ 3include_10.inc'
+ i = 1
+ end subroutine quux
+ program include_12
+ implicit none
+ include
+! comment
+ +'include_10.inc'
+ end program
--- gcc/testsuite/gfortran.dg/include_13.f90.jj 2018-11-12 14:38:05.488443863 +0100
+++ gcc/testsuite/gfortran.dg/include_13.f90 2018-11-12 15:04:42.921254180 +0100
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fdec" }
+subroutine foo
+ implicit none
+ incl& ! comment1
+&u&
+ &de & ! comment2
+'include&
+ &_10.inc'
+ i = 1
+end subroutine foo
+subroutine bar
+ implicit none
+include &
+
+! comment3
+
+"include_10.inc"
+ i = 1
+end subroutine bar
+subroutine baz
+ implicit none
+ include&
+&'include_10.&
+&inc'
+ i = 1
+end subroutine baz
+subroutine qux
+ implicit none
+ include '&
+include_10.inc'
+end subroutine qux
--- gcc/testsuite/gfortran.dg/gomp/include_1.f.jj 2018-11-12 15:24:27.455829721 +0100
+++ gcc/testsuite/gfortran.dg/gomp/include_1.f 2018-11-12 15:26:02.044278080 +0100
@@ -0,0 +1,49 @@
+c { dg-do compile }
+c { dg-options "-fopenmp -fdec" }
+ subroutine foo
+ implicit none
+c$ 0include 'include_1.inc'
+ i = 1
+ end subroutine foo
+ subroutine bar
+ implicit none
+ i
+C$ ;n
+ +c
+
+c some comment
+
+*$ ll
+C comment line
+ uu
+ DD
+ ee'include_1.inc'
+ i = 1
+ end subroutine bar
+ subroutine baz
+ implicit none
+ 0include
+ + 'include_1.inc'
+ i = 1
+ end subroutine baz
+ subroutine qux
+ implicit none
+!$ i n C lude 'inc
+* another comment line
+ &lude_1.inc'
+ i = 1
+ end subroutine qux
+ subroutine quux
+ implicit none
+C$ 0inc
+*$ 1lud
+c$ 2e '
+!$ 3include_1.inc'
+ i = 1
+ end subroutine quux
+ program include_12
+ implicit none
+ include
+! comment
+c$ +'include_1.inc'
+ end program
--- gcc/testsuite/gfortran.dg/gomp/include_1.inc.jj 2018-11-12 15:24:30.471780253 +0100
+++ gcc/testsuite/gfortran.dg/gomp/include_1.inc 2018-11-12 12:07:29.694854414 +0100
@@ -0,0 +1 @@
+ integer i
--- gcc/testsuite/gfortran.dg/gomp/include_2.f90.jj 2018-11-12 15:24:33.556729656 +0100
+++ gcc/testsuite/gfortran.dg/gomp/include_2.f90 2018-11-12 15:26:10.480139412 +0100
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fdec-include" }
+subroutine foo
+ implicit none
+!$ incl& ! comment1
+!$ &u&
+!$ &de & ! comment2
+!$ 'include&
+ &_1.inc'
+ i = 1
+end subroutine foo
+subroutine bar
+ implicit none
+!$ include &
+
+! comment3
+
+!$ "include_1.inc"
+ i = 1
+end subroutine bar
+subroutine baz
+ implicit none
+!$ include&
+!$ &'include_1.&
+!$ &inc'
+ i = 1
+end subroutine baz
+subroutine qux
+ implicit none
+!$ include '&
+include_1.inc'
+end subroutine qux
Jakub
More information about the Gcc-patches
mailing list