lang.opt (fdec-include): New option.

* 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.

Co-Authored-By: Mark Eggleston <mark.eggleston@codethink.com>

From-SVN: r266337

gcc/fortran/ChangeLog

@@ -1,3 +1,19 @@
+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.
+
 2018-11-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/88073

gcc/fortran/lang.opt

@@ -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

@@ -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

@@ -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,18 +2162,77 @@ 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;
 	}
     }
 
+  if (gfc_current_form == FORM_FREE)
+    {
       while (*c == ' ' || *c == '\t')
 	c++;
-
       if (gfc_wide_strncasecmp (c, "include", 7))
-    return false;
+	{
+	  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;
+
+	  /* At the end of line or comment this might be continued.  */
+	  if (*c == '\0' || *c == '!')
+	    return -1;
+
+	  return 0;
+	}
+    }
+
   while (*c == ' ' || *c == '\t')
     c++;
 
@@ -2177,15 +2240,47 @@ include_line (gfc_char_t *line)
 
   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')
+    {
+      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++;
 
@@ -2193,7 +2288,7 @@ include_line (gfc_char_t *line)
     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)
@@ -2370,7 +2587,8 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
 	 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.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,15 @@
+2018-11-21  Jakub Jelinek  <jakub@redhat.com>
+	    Mark Eggleston  <mark.eggleston@codethink.com>
+
+	* 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.
+
 2018-11-21  Andreas Krebbel  <krebbel@linux.ibm.com>
 
 	* gcc.target/s390/vector/align-1.c: New test.

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

gcc/testsuite/gfortran.dg/gomp/include_1.inc

@@ -0,0 +1 @@
+      integer i

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

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

gcc/testsuite/gfortran.dg/include_10.inc

@@ -0,0 +1 @@
+      integer i

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

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

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