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.

--- gcc/fortran/lang.opt

+++ gcc/fortran/lang.opt

@@ -432,6 +432,10 @@ fdec-pad-with-spaces

 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.

--- gcc/fortran/options.c

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

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

--- /dev/null

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

--- /dev/null

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

@@ -0,0 +1 @@

+      integer i

--- /dev/null

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

--- /dev/null

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

--- /dev/null

+++ gcc/testsuite/gfortran.dg/include_10.inc

@@ -0,0 +1 @@

+      integer i

--- /dev/null

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

--- /dev/null

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

--- /dev/null

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