2018-11-21 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.
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 2b7f2903761..fe0c6934220 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -440,6 +440,10 @@ fdec
Fortran Var(flag_dec_pad_with_spaces)
For character to integer conversions, use spaces for the pad rather than NUL.
+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.
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 73f5389361d..e59ba31ba7b 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -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;
}
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 55d6dafdb5d..5b27ab5e52d 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -2135,14 +2135,18 @@ static bool load_file (const char *, const char *, bool);
/* 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;
+ }
- if (gfc_wide_strncasecmp (c, "include", 7))
- return false;
+ 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;
+
+ /* 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, const char *displayedname, bool initial)
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, const char *displayedname, bool initial)
}
/* 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, const char *displayedname, bool initial)
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. */
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.f b/gcc/testsuite/gfortran.dg/gomp/include_1.f
new file mode 100644
index 00000000000..715eb5b97e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_1.inc b/gcc/testsuite/gfortran.dg/gomp/include_1.inc
new file mode 100644
index 00000000000..5dd841c5573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_1.inc
@@ -0,0 +1 @@
+ integer i
diff --git a/gcc/testsuite/gfortran.dg/gomp/include_2.f90 b/gcc/testsuite/gfortran.dg/gomp/include_2.f90
new file mode 100644
index 00000000000..9c4ff15afb8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/include_2.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/include_10.f b/gcc/testsuite/gfortran.dg/include_10.f
new file mode 100644
index 00000000000..7df2a196954
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_10.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/include_10.inc b/gcc/testsuite/gfortran.dg/include_10.inc
new file mode 100644
index 00000000000..5dd841c5573
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_10.inc
@@ -0,0 +1 @@
+ integer i
diff --git a/gcc/testsuite/gfortran.dg/include_11.f b/gcc/testsuite/gfortran.dg/include_11.f
new file mode 100644
index 00000000000..0e68a78c236
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_11.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/include_12.f b/gcc/testsuite/gfortran.dg/include_12.f
new file mode 100644
index 00000000000..4b3e3bed075
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_12.f
@@ -0,0 +1,65 @@
+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
+ subroutine quuz
+ implicit none
+ integer include
+ include
+ +"include_10.inc"
+ i = 1
+ include
+ + = 2
+ write (*,*) include
+ end subroutine quuz
+ subroutine corge
+ implicit none
+ include
+ +'include_10.inc'
+ i = 1
+ end subroutine corge
diff --git a/gcc/testsuite/gfortran.dg/include_13.f90 b/gcc/testsuite/gfortran.dg/include_13.f90
new file mode 100644
index 00000000000..418ee5585e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/include_13.f90
@@ -0,0 +1,44 @@
+! { 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
+subroutine quux
+ implicit none
+ include &
+ &'include_10.inc'
+ i = 1
+end subroutine quux
+subroutine quuz
+ implicit none
+ include &
+ &"include_10.inc"
+ i = 1
+end subroutine quuz