PR fortran/63858

	gcc/fortran/
	* scanner.c (skip_oacc_attribute): Remove continue_flag parameter.
	Rename as ...
	(skip_free_oacc_sentinel): ... this.
	(skip_omp_attribute): Remove continue_flag parameter. Rename as ...
	(skip_free_omp_sentinel): ... this.
	(skip_free_comments): Update to call skip_free_oacc_sentinel and
	skip_free_omp_sentinel.
	(skip_fixed_omp_sentinel): New function.
	(skip_fixed_oacc_sentinel): New function.
	(skip_fixed_comments): Fix mix of OpenACC and OpenMP sentinels in
	continuation.

	gcc/testsuite/
	* goacc/omp-fixed.f: New test.
	* goacc/omp.f95: Add check for mis-matched omp and acc continuations.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@230872 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 228 insertions, 108 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index adc39bb5b8c..da29a9d8f42 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2015-11-25  Ilmir Usmanov <me@ilmir.us>
+	    Cesar Philippidis  <cesar@codesourcery.com>
+
+	PR fortran/63858
+	* scanner.c (skip_oacc_attribute): Remove continue_flag parameter.
+	Rename as ...
+	(skip_free_oacc_sentinel): ... this.
+	(skip_omp_attribute): Remove continue_flag parameter. Rename as ...
+	(skip_free_omp_sentinel): ... this.
+	(skip_free_comments): Update to call skip_free_oacc_sentinel and
+	skip_free_omp_sentinel.
+	(skip_fixed_omp_sentinel): New function.
+	(skip_fixed_oacc_sentinel): New function.
+	(skip_fixed_comments): Fix mix of OpenACC and OpenMP sentinels in
+	continuation.
+
 2015-11-24  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/68486
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index bfb7d452e90..86441199b46 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -712,7 +712,7 @@ skip_gcc_attribute (locus start)
 
 /* Return true if CC was matched.  */
 static bool
-skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
+skip_free_oacc_sentinel (locus start, locus old_loc)
 {
   bool r = false;
   char c;
@@ -752,7 +752,7 @@ skip_oacc_attribute (locus start, locus old_loc, bool continue_flag)
 
 /* Return true if MP was matched.  */
 static bool
-skip_omp_attribute (locus start, locus old_loc, bool continue_flag)
+skip_free_omp_sentinel (locus start, locus old_loc)
 {
   bool r = false;
   char c;
@@ -841,7 +841,7 @@ skip_free_comments (void)
 		    c = next_char ();
 		    if (c == 'o' || c == 'O')
 		      {
-			if (skip_omp_attribute (start, old_loc, continue_flag))
+			if (skip_free_omp_sentinel (start, old_loc))
 			  return false;
 			gfc_current_locus = old_loc;
 			next_char ();
@@ -849,7 +849,7 @@ skip_free_comments (void)
 		      }
 		    else if (c == 'a' || c == 'A')
 		      {
-			if (skip_oacc_attribute (start, old_loc, continue_flag))
+			if (skip_free_oacc_sentinel (start, old_loc))
 			  return false;
 			gfc_current_locus = old_loc;
 			next_char ();
@@ -874,7 +874,7 @@ skip_free_comments (void)
 		    c = next_char ();
 		    if (c == 'o' || c == 'O')
 		      {
-			if (skip_omp_attribute (start, old_loc, continue_flag))
+			if (skip_free_omp_sentinel (start, old_loc))
 			  return false;
 			gfc_current_locus = old_loc;
 			next_char ();
@@ -899,8 +899,7 @@ skip_free_comments (void)
 		    c = next_char ();
 		      if (c == 'a' || c == 'A')
 			{
-			  if (skip_oacc_attribute (start, old_loc, 
-						   continue_flag))
+			  if (skip_free_oacc_sentinel (start, old_loc))
 			    return false;
 			  gfc_current_locus = old_loc;
 			  next_char();
@@ -935,6 +934,63 @@ skip_free_comments (void)
   return false;
 }
 
+/* Return true if MP was matched in fixed form.  */
+static bool
+skip_fixed_omp_sentinel (locus *start)
+{
+  gfc_char_t c;
+  if (((c = next_char ()) == 'm' || c == 'M')
+      && ((c = next_char ()) == 'p' || c == 'P'))
+    {
+      c = next_char ();
+      if (c != '\n'
+	  && (continue_flag
+	      || c == ' ' || c == '\t' || c == '0'))
+	{
+	  do
+	    c = next_char ();
+	  while (gfc_is_whitespace (c));
+	  if (c != '\n' && c != '!')
+	    {
+	      /* Canonicalize to *$omp.  */
+	      *start->nextc = '*';
+	      openmp_flag = 1;
+	      gfc_current_locus = *start;
+	      return true;
+	    }
+	}
+    }
+  return false;
+}
+
+/* Return true if CC was matched in fixed form.  */
+static bool
+skip_fixed_oacc_sentinel (locus *start)
+{
+  gfc_char_t c;
+  if (((c = next_char ()) == 'c' || c == 'C')
+      && ((c = next_char ()) == 'c' || c == 'C'))
+    {
+      c = next_char ();
+      if (c != '\n'
+	  && (continue_flag
+	      || c == ' ' || c == '\t' || c == '0'))
+	{
+	  do
+	    c = next_char ();
+	  while (gfc_is_whitespace (c));
+	  if (c != '\n' && c != '!')
+	    {
+	      /* Canonicalize to *$acc.  */
+	      *start->nextc = '*';
+	      openacc_flag = 1;
+	      gfc_current_locus = *start;
+	      return true;
+	    }
+	}
+    }
+  return false;
+}
 
 /* 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 '*'
@@ -1003,128 +1059,92 @@ skip_fixed_comments (void)
 	      && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
 	    continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
 
-	  if (flag_openmp || flag_openmp_simd)
+	  if ((flag_openmp || flag_openmp_simd) && !flag_openacc)
 	    {
 	      if (next_char () == '$')
 		{
 		  c = next_char ();
 		  if (c == 'o' || c == 'O')
 		    {
-		      if (((c = next_char ()) == 'm' || c == 'M')
-			  && ((c = next_char ()) == 'p' || c == 'P'))
-			{
-			  c = next_char ();
-			  if (c != '\n'
-			      && ((openmp_flag && continue_flag)
-				  || c == ' ' || c == '\t' || c == '0'))
-			    {
-			      do
-				c = next_char ();
-			      while (gfc_is_whitespace (c));
-			      if (c != '\n' && c != '!')
-				{
-				  /* Canonicalize to *$omp.  */
-				  *start.nextc = '*';
-				  openmp_flag = 1;
-				  gfc_current_locus = start;
-				  return;
-				}
-			    }
-			}
+		      if (skip_fixed_omp_sentinel (&start))
+			return;
 		    }
 		  else
+		    goto check_for_digits;
+		}
+	      gfc_current_locus = start;
+	    }
+
+	  if (flag_openacc && !(flag_openmp || flag_openmp_simd))
+	    {
+	      if (next_char () == '$')
+		{
+		  c = next_char ();
+		  if (c == 'a' || c == 'A')
 		    {
-		      int digit_seen = 0;
-
-		      for (col = 3; col < 6; col++, c = next_char ())
-			if (c == ' ')
-			  continue;
-			else if (c == '\t')
-			  {
-			    col = 6;
-			    break;
-			  }
-			else if (c < '0' || c > '9')
-			  break;
-			else
-			  digit_seen = 1;
-
-		      if (col == 6 && c != '\n'
-			  && ((continue_flag && !digit_seen)
-			      || c == ' ' || c == '\t' || c == '0'))
-			{
-			  gfc_current_locus = start;
-			  start.nextc[0] = ' ';
-			  start.nextc[1] = ' ';
-			  continue;
-			}
+		      if (skip_fixed_oacc_sentinel (&start))
+			return;
 		    }
+		  else
+		    goto check_for_digits;
 		}
 	      gfc_current_locus = start;
 	    }
 
-	  if (flag_openacc)
+	  if (flag_openacc || flag_openmp || flag_openmp_simd)
 	    {
 	      if (next_char () == '$')
 		{
 		  c = next_char ();
 		  if (c == 'a' || c == 'A')
 		    {
-		      if (((c = next_char ()) == 'c' || c == 'C')
-			  && ((c = next_char ()) == 'c' || c == 'C'))
-			{
-			  c = next_char ();
-			  if (c != '\n'
-			      && ((openacc_flag && continue_flag)
-				  || c == ' ' || c == '\t' || c == '0'))
-			    {
-			      do
-				c = next_char ();
-			      while (gfc_is_whitespace (c));
-			      if (c != '\n' && c != '!')
-				{
-				  /* Canonicalize to *$acc. */
-				  *start.nextc = '*';
-				  openacc_flag = 1;
-				  gfc_current_locus = start;
-				  return;
-				}
-			    }
-			}
+		      if (skip_fixed_oacc_sentinel (&start))
+			return;
 		    }
-		  else
+		  else if (c == 'o' || c == 'O')
 		    {
-		      int digit_seen = 0;
-
-		      for (col = 3; col < 6; col++, c = next_char ())
-			if (c == ' ')
-			  continue;
-			else if (c == '\t')
-			  {
-			    col = 6;
-			    break;
-			  }
-			else if (c < '0' || c > '9')
-			  break;
-			else
-			  digit_seen = 1;
-
-		      if (col == 6 && c != '\n'
-			  && ((continue_flag && !digit_seen)
-			      || c == ' ' || c == '\t' || c == '0'))
-			{
-			  gfc_current_locus = start;
-			  start.nextc[0] = ' ';
-			  start.nextc[1] = ' ';
-			  continue;
-			}
+		      if (skip_fixed_omp_sentinel (&start))
+			return;
 		    }
+		  else
+		    goto check_for_digits;
 		}
 	      gfc_current_locus = start;
 	    }
 
 	  skip_comment_line ();
 	  continue;
+
+	  gcc_unreachable ();
+check_for_digits:
+	  {
+	    int digit_seen = 0;
+
+	    for (col = 3; col < 6; col++, c = next_char ())
+	      if (c == ' ')
+		continue;
+	      else if (c == '\t')
+		{
+		  col = 6;
+		  break;
+		}
+	      else if (c < '0' || c > '9')
+		break;
+	      else
+		digit_seen = 1;
+
+	    if (col == 6 && c != '\n'
+		&& ((continue_flag && !digit_seen)
+		    || c == ' ' || c == '\t' || c == '0'))
+	      {
+		gfc_current_locus = start;
+		start.nextc[0] = ' ';
+		start.nextc[1] = ' ';
+		continue;
+	      }
+	    }
+	  skip_comment_line ();
+	  continue;
 	}
 
       if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
@@ -1321,7 +1341,7 @@ restart:
 	continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
 
       if (flag_openmp)
-	if (prev_openmp_flag != openmp_flag)
+	if (prev_openmp_flag != openmp_flag && !openacc_flag)
 	  {
 	    gfc_current_locus = old_loc;
 	    openmp_flag = prev_openmp_flag;
@@ -1330,7 +1350,7 @@ restart:
 	  }
 
       if (flag_openacc)
-	if (prev_openacc_flag != openacc_flag)
+	if (prev_openacc_flag != openacc_flag && !openmp_flag)
 	  {
 	    gfc_current_locus = old_loc;
 	    openacc_flag = prev_openacc_flag;
@@ -1349,7 +1369,7 @@ restart:
       while (gfc_is_whitespace (c))
 	c = next_char ();
 
-      if (openmp_flag)
+      if (openmp_flag && !openacc_flag)
 	{
 	  for (i = 0; i < 5; i++, c = next_char ())
 	    {
@@ -1360,7 +1380,7 @@ restart:
 	  while (gfc_is_whitespace (c))
 	    c = next_char ();
 	}
-      if (openacc_flag)
+      if (openacc_flag && !openmp_flag)
 	{
 	  for (i = 0; i < 5; i++, c = next_char ())
 	    {
@@ -1372,6 +1392,26 @@ restart:
 	    c = next_char ();
 	}
 
+      /* In case we have an OpenMP directive continued by OpenACC
+	 sentinel, or vice versa, we get both openmp_flag and
+	 openacc_flag on.  */
+
+      if (openacc_flag && openmp_flag)
+	{
+	  int is_openmp = 0;
+	  for (i = 0; i < 5; i++, c = next_char ())
+	    {
+	      if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i])
+		is_openmp = 1;
+	      if (i == 4)
+		old_loc = gfc_current_locus;
+	    }
+	  gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: "
+		     "expected !$ACC, got !$OMP"
+		     : "Wrong OpenMP continuation at %C: "
+		     "expected !$OMP, got !$ACC");
+	}
+
       if (c != '&')
 	{
 	  if (in_string)
@@ -1436,18 +1476,35 @@ restart:
       skip_fixed_comments ();
 
       /* See if this line is a continuation line.  */
-      if (flag_openmp && openmp_flag != prev_openmp_flag)
+      if (flag_openmp && openmp_flag != prev_openmp_flag && !openacc_flag)
 	{
 	  openmp_flag = prev_openmp_flag;
 	  goto not_continuation;
 	}
-      if (flag_openacc && openacc_flag != prev_openacc_flag)
+      if (flag_openacc && openacc_flag != prev_openacc_flag && !openmp_flag)
 	{
 	  openacc_flag = prev_openacc_flag;
 	  goto not_continuation;
 	}
 
-      if (!openmp_flag && !openacc_flag)
+      /* In case we have an OpenMP directive continued by OpenACC
+	 sentinel, or vice versa, we get both openmp_flag and
+	 openacc_flag on.  */
+      if (openacc_flag && openmp_flag)
+	{
+	  int is_openmp = 0;
+	  for (i = 0; i < 5; i++)
+	    {
+	      c = next_char ();
+	      if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
+		is_openmp = 1;
+	    }
+	  gfc_error (is_openmp ? "Wrong OpenACC continuation at %C: "
+		     "expected !$ACC, got !$OMP"
+		     : "Wrong OpenMP continuation at %C: "
+		     "expected !$OMP, got !$ACC");
+	}
+      else if (!openmp_flag && !openacc_flag)
 	for (i = 0; i < 5; i++)
 	  {
 	    c = next_char ();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 47ed2acef54..58bd40ab404 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2015-11-25  Ilmir Usmanov <me@ilmir.us>
+	    Cesar Philippidis  <cesar@codesourcery.com>
+
+	PR fortran/63858
+	* goacc/omp-fixed.f: New test.
+	* goacc/omp.f95: Add check for mis-matched omp and acc continuations.
+
 2015-11-25  Richard Biener  <rguenther@suse.de>
 
 	PR middle-end/68528
diff --git a/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
new file mode 100644
index 00000000000..e715673de16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-additional-options "-fopenmp" }
+      SUBROUTINE ICHI
+      INTEGER :: ARGC
+      ARGC = COMMAND_ARGUMENT_COUNT ()
+
+!$OMP PARALLEL
+!$ACC PARALLEL                                                          &
+!$ACC& COPYIN(ARGC) ! { dg-error "directive cannot be specified within" }
+      IF (ARGC .NE. 0) THEN
+         CALL ABORT
+      END IF
+!$ACC END PARALLEL
+!$OMP END PARALLEL
+
+      END SUBROUTINE ICHI
+
+
+      SUBROUTINE NI
+      IMPLICIT NONE
+      INTEGER :: I
+
+!$ACC PARALLEL                                                          &
+!$OMP& DO ! { dg-error "Wrong OpenACC continuation" }
+      DO I = 1, 10
+      ENDDO
+
+!$OMP PARALLEL                                                          &
+!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" }
+      DO I = 1, 10
+      ENDDO
+      END SUBROUTINE NI
diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95
index 24f639ff54a..339438ab772 100644
--- a/gcc/testsuite/gfortran.dg/goacc/omp.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95
@@ -63,4 +63,12 @@ contains
      !$omp end parallel
      !$acc end data
    end subroutine roku
-end module test
\ No newline at end of file
+
+   subroutine nana
+     !$acc parallel &
+     !$omp do ! { dg-error "Wrong OpenACC continuation" }
+
+     !$omp parallel &
+     !$acc loop ! { dg-error "Wrong OpenMP continuation" }
+   end subroutine nana
+end module test