Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Ilmir Usmanov]

[-- Attachment #1: Type: text/plain, Size: 2340 bytes --]

Hi Cesar!

Thanks for your review!

08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
> On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
>>  Fixed fortran mail-list address. Sorry for inconvenience.
>>
>>  08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
>>>>  Hi Cesar!
>>>>
>>>>  This patch fixes checks of OpenMP and OpenACC continuations in
>>>>  case if someone mixes them (i.e. continues OpenMP directive with
>>>>  !$ACC sentinel or vice versa).
>>>>
>>>>  OK for gomp branch?
>
> Thanks for working on this. Does this fix PR63858 by any chance?
No problem. I had a feeling that something is wrong in the scanner since 
I've committed an initial support of OpenACC ver. 1.0 to gomp branch 
(more than a year ago).
Now it does fix the PR, because I've added support of fixed form to the 
patch. BTW, your test in the PR has a wrong continuation. Fixed test 
added to the patch.

>
> two minor nits...
>
>>  0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch
>>
>>  From 5492bf5bc991b6924f5e3b35c11eeaed745df073 Mon Sep 17 00:00:00 2001
>>  From: Ilmir Usmanov <i.usmanov@samsung.com>
>>  Date: Sun, 7 Jun 2015 23:55:22 +0300
>>  Subject: [PATCH] Fix mix of OpenACC and OpenMP sentinels in continuation
>>
>>  ---
>>   gcc/fortran/ChangeLog | 5 +++++
>
> Use ChangeLog.gomp for gomp-4_0-branch.
Done.

>
>>  + /* 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 ("Wrong %s continuation at %C: expected %s, got %s",
>>  + is_openmp ? "OpenACC" : "OpenMP",
>>  + is_openmp ? "!$ACC" : "!$OMP",
>>  + is_openmp ? "!$OMP" : "!$ACC");
>
> I think it's better for the translation project if you made this a
> complete string. So maybe change this line into
>
>   gfc_error (is_openmp ? "Wrong continuation at %C: expected !$ACC, got"
>              " !$OMP",
>              : "Wrong continuation at %C: expected !$OMP, got !$ACC");
Done

>
> Other than that, it looks fine.
>
> Thanks,
> Cesar

OK for gomp branch?

--
Ilmir.




[-- Attachment #2: 0001-PR-63858.patch --]
[-- Type: text/x-diff, Size: 12208 bytes --]

From dc98062b499838ca4391c0ed497f40205267a44e Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <me@ilmir.us>
Date: Tue, 30 Jun 2015 03:05:23 +0300
Subject: [PATCH] PR/63858

---
 gcc/fortran/ChangeLog.gomp                  |  10 ++
 gcc/fortran/scanner.c                       | 259 +++++++++++++++++-----------
 gcc/testsuite/ChangeLog.gomp                |   7 +
 gcc/testsuite/gfortran.dg/goacc/omp-fixed.f |  32 ++++
 gcc/testsuite/gfortran.dg/goacc/omp.f95     |   8 +
 5 files changed, 216 insertions(+), 100 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/omp-fixed.f

diff --git a/gcc/fortran/ChangeLog.gomp b/gcc/fortran/ChangeLog.gomp
index aa02ffe..0a5bf47 100644
--- a/gcc/fortran/ChangeLog.gomp
+++ b/gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,13 @@
+2015-06-30  Ilmir Usmanov  <me@ilmir.us>
+
+	PR/63858
+	Fix mix of OpenACC and OpenMP sentinels in continuation.
+	* scanner.c (skip_omp_attribute_fixed, skip_oacc_attribute_fixed): New
+	functions.
+	(skip_fixed_comments): Fix mix of OpenACC and OpenMP sentinels in
+	continuation.
+	(gfc_next_char_literal): Likewise.
+
 2015-06-18  James Norris  <jnorris@codesourcery.com>
 
 	* trans-decl.c (find_module_oacc_declare_clauses): Fix setting of
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index f0e6404..d66cf65 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -935,6 +935,63 @@ skip_free_comments (void)
   return false;
 }
 
+/* Return true if MP was matched in fixed form.  */
+static bool
+skip_omp_attribute_fixed (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_oacc_attribute_fixed (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 *$omp.  */
+	      *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 +1060,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_omp_attribute_fixed (&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_oacc_attribute_fixed (&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_oacc_attribute_fixed (&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_omp_attribute_fixed (&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'))
@@ -1331,7 +1352,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;
@@ -1340,7 +1361,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;
@@ -1359,7 +1380,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 ())
 	    {
@@ -1370,7 +1391,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 ())
 	    {
@@ -1382,6 +1403,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)
@@ -1444,18 +1485,36 @@ 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)
+	{
+	  locus saved_loc = gfc_current_locus;
+	  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.gomp b/gcc/testsuite/ChangeLog.gomp
index 23a7632..1b2fafc 100644
--- a/gcc/testsuite/ChangeLog.gomp
+++ b/gcc/testsuite/ChangeLog.gomp
@@ -1,3 +1,10 @@
+2015-06-30  Ilmir Usmanov  <me@ilmir.us>
+
+	PR/63858
+	Fix mix of OpenACC and OpenMP sentinels in continuation.
+	* gfortran.dg/goacc/omp.f95: Add test case for free form.
+	* gfortran.dg/goacc/omp-fixed.f: New test for fixed form.
+
 2015-06-24  James Norris  <jnorris@codesourcery.com>
 
 	* c-c++-common/goacc/declare-1.c: Update tests.
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 0000000..e715673
--- /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 24f639f..a7333eb 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
+
+   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
\ No newline at end of file
-- 
1.8.4.5

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Ilmir Usmanov]

Ping

On 07.07.2015 14:27, Ilmir Usmanov wrote:
> Ping
>
> 30.06.2015, 03:43, "Ilmir Usmanov" <me@ilmir.us>:
>> Hi Cesar!
>>
>> Thanks for your review!
>>
>> 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
>>>   On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
>>>>    Fixed fortran mail-list address. Sorry for inconvenience.
>>>>
>>>>    08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
>>>>>>    Hi Cesar!
>>>>>>
>>>>>>    This patch fixes checks of OpenMP and OpenACC continuations in
>>>>>>    case if someone mixes them (i.e. continues OpenMP directive with
>>>>>>    !$ACC sentinel or vice versa).
>>>>>>
>>>>>>    OK for gomp branch?
>>>   Thanks for working on this. Does this fix PR63858 by any chance?
>> No problem. I had a feeling that something is wrong in the scanner since
>> I've committed an initial support of OpenACC ver. 1.0 to gomp branch
>> (more than a year ago).
>> Now it does fix the PR, because I've added support of fixed form to the
>> patch. BTW, your test in the PR has a wrong continuation. Fixed test
>> added to the patch.
>>
>>>   two minor nits...
>>>
>>>>    0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch
>>>>
>>>>    From 5492bf5bc991b6924f5e3b35c11eeaed745df073 Mon Sep 17 00:00:00 2001
>>>>    From: Ilmir Usmanov <i.usmanov@samsung.com>
>>>>    Date: Sun, 7 Jun 2015 23:55:22 +0300
>>>>    Subject: [PATCH] Fix mix of OpenACC and OpenMP sentinels in continuation
>>>>
>>>>    ---
>>>>     gcc/fortran/ChangeLog | 5 +++++
>>>   Use ChangeLog.gomp for gomp-4_0-branch.
>> Done.
>>
>>>>    + /* 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 ("Wrong %s continuation at %C: expected %s, got %s",
>>>>    + is_openmp ? "OpenACC" : "OpenMP",
>>>>    + is_openmp ? "!$ACC" : "!$OMP",
>>>>    + is_openmp ? "!$OMP" : "!$ACC");
>>>   I think it's better for the translation project if you made this a
>>>   complete string. So maybe change this line into
>>>
>>>     gfc_error (is_openmp ? "Wrong continuation at %C: expected !$ACC, got"
>>>                " !$OMP",
>>>                : "Wrong continuation at %C: expected !$OMP, got !$ACC");
>> Done
>>
>>>   Other than that, it looks fine.
>>>
>>>   Thanks,
>>>   Cesar
>> OK for gomp branch?
>>
>> --
>> Ilmir.
> --
> Ilmir.
>
-- 
Ilmir.

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Cesar Philippidis]

On 07/14/2015 02:20 PM, Ilmir Usmanov wrote:
> Ping

Sorry, I thought I had already approved this. It's fine for gomp-4_0-branch.

Cesar

> On 07.07.2015 14:27, Ilmir Usmanov wrote:
>> Ping
>>
>> 30.06.2015, 03:43, "Ilmir Usmanov" <me@ilmir.us>:
>>> Hi Cesar!
>>>
>>> Thanks for your review!
>>>
>>> 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
>>>>   On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
>>>>>    Fixed fortran mail-list address. Sorry for inconvenience.
>>>>>
>>>>>    08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
>>>>>>>    Hi Cesar!
>>>>>>>
>>>>>>>    This patch fixes checks of OpenMP and OpenACC continuations in
>>>>>>>    case if someone mixes them (i.e. continues OpenMP directive with
>>>>>>>    !$ACC sentinel or vice versa).
>>>>>>>
>>>>>>>    OK for gomp branch?
>>>>   Thanks for working on this. Does this fix PR63858 by any chance?
>>> No problem. I had a feeling that something is wrong in the scanner since
>>> I've committed an initial support of OpenACC ver. 1.0 to gomp branch
>>> (more than a year ago).
>>> Now it does fix the PR, because I've added support of fixed form to the
>>> patch. BTW, your test in the PR has a wrong continuation. Fixed test
>>> added to the patch.
>>>
>>>>   two minor nits...
>>>>
>>>>>    0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch
>>>>>
>>>>>    From 5492bf5bc991b6924f5e3b35c11eeaed745df073 Mon Sep 17
>>>>> 00:00:00 2001
>>>>>    From: Ilmir Usmanov <i.usmanov@samsung.com>
>>>>>    Date: Sun, 7 Jun 2015 23:55:22 +0300
>>>>>    Subject: [PATCH] Fix mix of OpenACC and OpenMP sentinels in
>>>>> continuation
>>>>>
>>>>>    ---
>>>>>     gcc/fortran/ChangeLog | 5 +++++
>>>>   Use ChangeLog.gomp for gomp-4_0-branch.
>>> Done.
>>>
>>>>>    + /* 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 ("Wrong %s continuation at %C: expected %s, got %s",
>>>>>    + is_openmp ? "OpenACC" : "OpenMP",
>>>>>    + is_openmp ? "!$ACC" : "!$OMP",
>>>>>    + is_openmp ? "!$OMP" : "!$ACC");
>>>>   I think it's better for the translation project if you made this a
>>>>   complete string. So maybe change this line into
>>>>
>>>>     gfc_error (is_openmp ? "Wrong continuation at %C: expected
>>>> !$ACC, got"
>>>>                " !$OMP",
>>>>                : "Wrong continuation at %C: expected !$OMP, got
>>>> !$ACC");
>>> Done
>>>
>>>>   Other than that, it looks fine.
>>>>
>>>>   Thanks,
>>>>   Cesar
>>> OK for gomp branch?
>>>
>>> -- 
>>> Ilmir.
>> -- 
>> Ilmir.
>>

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Thomas Schwinge]

[-- Attachment #1: Type: text/plain, Size: 1943 bytes --]

Hi!

On Tue, 30 Jun 2015 03:39:42 +0300, Ilmir Usmanov <me@ilmir.us> wrote:
> 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
> > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
> >>  08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
> >>>>  This patch fixes checks of OpenMP and OpenACC continuations in
> >>>>  case if someone mixes them (i.e. continues OpenMP directive with
> >>>>  !$ACC sentinel or vice versa).

Thanks for working on this!

> >>>>  OK for gomp branch?

The same applies to GCC trunk, as far as I can tell -- any reason not to
apply the patch to trunk?

> > Thanks for working on this. Does this fix PR63858 by any chance?
> No problem. I had a feeling that something is wrong in the scanner since 
> I've committed an initial support of OpenACC ver. 1.0 to gomp branch 
> (more than a year ago).
> Now it does fix the PR, because I've added support of fixed form to the 
> patch. BTW, your test in the PR has a wrong continuation. Fixed test 
> added to the patch.

I understand correctly that your patch does fix
<https://gcc.gnu.org/PR63858>, right?  In that case, please assign the PR
to yourself, and close it as fixed, once it is fixed in trunk.

> --- a/gcc/fortran/ChangeLog.gomp
> +++ b/gcc/fortran/ChangeLog.gomp
> @@ -1,3 +1,13 @@
> +2015-06-30  Ilmir Usmanov  <me@ilmir.us>
> +
> +	PR/63858

The format to use is PR [component]/[number], so here: PR fortran/63858.

> --- a/gcc/testsuite/ChangeLog.gomp
> +++ b/gcc/testsuite/ChangeLog.gomp
> @@ -1,3 +1,10 @@
> +2015-06-30  Ilmir Usmanov  <me@ilmir.us>
> +
> +	PR/63858

Same.

> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
> @@ -0,0 +1,32 @@
> +! { dg-do compile }
> +! { dg-additional-options "-fopenmp" }

For C, C++, we have a goacc-gomp directory, where both OpenACC and OpenMP
are enabled -- does that make sense to have for Fortran, too?


Grüße,
 Thomas

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]

[PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations

[Thomas Schwinge]

[-- Attachment #1: Type: text/plain, Size: 12439 bytes --]

Hi!

On Mon, 27 Jul 2015 16:14:17 +0200, I wrote:
> On Tue, 30 Jun 2015 03:39:42 +0300, Ilmir Usmanov <me@ilmir.us> wrote:
> > 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
> > > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
> > >>  08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
> > >>>>  This patch fixes checks of OpenMP and OpenACC continuations in
> > >>>>  case if someone mixes them (i.e. continues OpenMP directive with
> > >>>>  !$ACC sentinel or vice versa).
> 
> Thanks for working on this!
> 
> > >>>>  OK for gomp branch?
> 
> The same applies to GCC trunk, as far as I can tell -- any reason not to
> apply the patch to trunk?

Ping -- OK to commit the following (by Ilmir) to trunk:

commit 38e62678ef11f349f029d42439668071f170e059
Author: Ilmir Usmanov <me@ilmir.us>
Date:   Sun Jul 26 12:10:36 2015 +0000

    [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations
    
    	gcc/fortran/
    	PR fortran/63858
    	* scanner.c (skip_omp_attribute_fixed, skip_oacc_attribute_fixed):
    	New functions.
    	(skip_fixed_comments, gfc_next_char_literal): Fix mix of OpenACC
    	and OpenMP sentinels in continuation.
    	gcc/testsuite/
    	PR fortran/63858
    	* gfortran.dg/goacc/omp-fixed.f: New file.
    	* gfortran.dg/goacc/omp.f95: Extend.
---
 gcc/fortran/scanner.c                       | 258 +++++++++++++++++-----------
 gcc/testsuite/gfortran.dg/goacc/omp-fixed.f |  32 ++++
 gcc/testsuite/gfortran.dg/goacc/omp.f95     |  10 +-
 3 files changed, 199 insertions(+), 101 deletions(-)

diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c
index bfb7d45..1e1ea84 100644
--- gcc/fortran/scanner.c
+++ gcc/fortran/scanner.c
@@ -935,6 +935,63 @@ skip_free_comments (void)
   return false;
 }
 
+/* Return true if MP was matched in fixed form.  */
+static bool
+skip_omp_attribute_fixed (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_oacc_attribute_fixed (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 *$omp.  */
+	      *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 +1060,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_omp_attribute_fixed (&start))
+			return;
 		    }
 		  else
-		    {
-		      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;
+		    goto check_for_digits;
+		}
+	      gfc_current_locus = start;
+	    }
 
-		      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 (flag_openacc && !(flag_openmp || flag_openmp_simd))
+	    {
+	      if (next_char () == '$')
+		{
+		  c = next_char ();
+		  if (c == 'a' || c == 'A')
+		    {
+		      if (skip_oacc_attribute_fixed (&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_oacc_attribute_fixed (&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_omp_attribute_fixed (&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 +1342,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 +1351,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 +1370,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 +1381,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 +1393,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 +1477,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 gcc/testsuite/gfortran.dg/goacc/omp-fixed.f gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
new file mode 100644
index 0000000..e715673
--- /dev/null
+++ 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 gcc/testsuite/gfortran.dg/goacc/omp.f95 gcc/testsuite/gfortran.dg/goacc/omp.f95
index 24f639f..339438a 100644
--- gcc/testsuite/gfortran.dg/goacc/omp.f95
+++ 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


Grüße,
 Thomas

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]

Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations

[Thomas Schwinge]

[-- Attachment #1: Type: text/plain, Size: 13400 bytes --]

Hi!

Ping...

On Fri, 9 Oct 2015 12:15:24 +0200, I wrote:
> On Mon, 27 Jul 2015 16:14:17 +0200, I wrote:
> > On Tue, 30 Jun 2015 03:39:42 +0300, Ilmir Usmanov <me@ilmir.us> wrote:
> > > 08.06.2015, 17:59, "Cesar Philippidis" <cesar@codesourcery.com>:
> > > > On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
> > > >>  08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
> > > >>>>  This patch fixes checks of OpenMP and OpenACC continuations in
> > > >>>>  case if someone mixes them (i.e. continues OpenMP directive with
> > > >>>>  !$ACC sentinel or vice versa).
> > 
> > Thanks for working on this!
> > 
> > > >>>>  OK for gomp branch?
> > 
> > The same applies to GCC trunk, as far as I can tell -- any reason not to
> > apply the patch to trunk?
> 
> Ping -- OK to commit the following (by Ilmir) to trunk:
> 
> commit 38e62678ef11f349f029d42439668071f170e059
> Author: Ilmir Usmanov <me@ilmir.us>
> Date:   Sun Jul 26 12:10:36 2015 +0000
> 
>     [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations
>     
>     	gcc/fortran/
>     	PR fortran/63858
>     	* scanner.c (skip_omp_attribute_fixed, skip_oacc_attribute_fixed):
>     	New functions.
>     	(skip_fixed_comments, gfc_next_char_literal): Fix mix of OpenACC
>     	and OpenMP sentinels in continuation.
>     	gcc/testsuite/
>     	PR fortran/63858
>     	* gfortran.dg/goacc/omp-fixed.f: New file.
>     	* gfortran.dg/goacc/omp.f95: Extend.
> ---
>  gcc/fortran/scanner.c                       | 258 +++++++++++++++++-----------
>  gcc/testsuite/gfortran.dg/goacc/omp-fixed.f |  32 ++++
>  gcc/testsuite/gfortran.dg/goacc/omp.f95     |  10 +-
>  3 files changed, 199 insertions(+), 101 deletions(-)
> 
> diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c
> index bfb7d45..1e1ea84 100644
> --- gcc/fortran/scanner.c
> +++ gcc/fortran/scanner.c
> @@ -935,6 +935,63 @@ skip_free_comments (void)
>    return false;
>  }
>  
> +/* Return true if MP was matched in fixed form.  */
> +static bool
> +skip_omp_attribute_fixed (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_oacc_attribute_fixed (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 *$omp.  */
> +	      *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 +1060,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_omp_attribute_fixed (&start))
> +			return;
>  		    }
>  		  else
> -		    {
> -		      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;
> +		    goto check_for_digits;
> +		}
> +	      gfc_current_locus = start;
> +	    }
>  
> -		      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 (flag_openacc && !(flag_openmp || flag_openmp_simd))
> +	    {
> +	      if (next_char () == '$')
> +		{
> +		  c = next_char ();
> +		  if (c == 'a' || c == 'A')
> +		    {
> +		      if (skip_oacc_attribute_fixed (&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_oacc_attribute_fixed (&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_omp_attribute_fixed (&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 +1342,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 +1351,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 +1370,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 +1381,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 +1393,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 +1477,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 gcc/testsuite/gfortran.dg/goacc/omp-fixed.f gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
> new file mode 100644
> index 0000000..e715673
> --- /dev/null
> +++ 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 gcc/testsuite/gfortran.dg/goacc/omp.f95 gcc/testsuite/gfortran.dg/goacc/omp.f95
> index 24f639f..339438a 100644
> --- gcc/testsuite/gfortran.dg/goacc/omp.f95
> +++ 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


Grüße
 Thomas

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]

Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations

[Jakub Jelinek]

On Fri, Oct 09, 2015 at 12:15:24PM +0200, Thomas Schwinge wrote:
> diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c
> index bfb7d45..1e1ea84 100644
> --- gcc/fortran/scanner.c
> +++ gcc/fortran/scanner.c
> @@ -935,6 +935,63 @@ skip_free_comments (void)
>    return false;
>  }
>  
> +/* Return true if MP was matched in fixed form.  */
> +static bool
> +skip_omp_attribute_fixed (locus *start)

Technically, this isn't attribute, but sentinel.
So, skip_fixed_omp_sentinel?  I know the free functions
are called attribute, perhaps we should rename them too,
patch to do so preapproved.

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

The original code checked here
	(openmp_flag && continue_flag)
instead.  Is that change intentional?
Looking around, we probably don't have a testcase coverage for say
fixed form:

C*OMP+PARALLEL DO
do ...

(i.e. where it starts with an OpenMP (or OpenACC) continuation, without
non-continued line first), or for free form where:

something &
!$omp & parallel

(ditto for OpenACC).

> +	  while (gfc_is_whitespace (c));
> +	  if (c != '\n' && c != '!')
> +	    {
> +	      /* Canonicalize to *$omp.  */

The comment has a pasto, by storing * you canonicalize to *$acc.

> -	  if (flag_openacc)
> +	  if (flag_openacc || (flag_openmp || flag_openmp_simd))

I'd just write
	if (flag_openacc || flag_openmp || flag_openmp_simd)
the ()s around are just misleading.

Anyway, if the removal of "openmp_flag &&" is intentional, then
the patch is ok with the above mentioned changes.  We can deal with the
cases I've mentioned up above in a follow-up.

	Jakub

Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations

[Cesar Philippidis]

[-- Attachment #1: Type: text/plain, Size: 2710 bytes --]

On 10/20/2015 02:37 AM, Jakub Jelinek wrote:
> On Fri, Oct 09, 2015 at 12:15:24PM +0200, Thomas Schwinge wrote:
>> diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c
>> index bfb7d45..1e1ea84 100644
>> --- gcc/fortran/scanner.c
>> +++ gcc/fortran/scanner.c
>> @@ -935,6 +935,63 @@ skip_free_comments (void)
>>    return false;
>>  }
>>  
>> +/* Return true if MP was matched in fixed form.  */
>> +static bool
>> +skip_omp_attribute_fixed (locus *start)
> 
> Technically, this isn't attribute, but sentinel.
> So, skip_fixed_omp_sentinel?  I know the free functions
> are called attribute, perhaps we should rename them too,
> patch to do so preapproved.

I've renamed those functions in this patch. The free variants are named
skip_free_*_sentinel.

>> +{
>> +  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
> 
> The original code checked here
> 	(openmp_flag && continue_flag)
> instead.  Is that change intentional?

I think so. Without it, continuations won't work with -fopenmp-simd.
Note how that function call is guarded by

  if ((flag_openmp || flag_openmp_simd) && !flag_openacc)

> Looking around, we probably don't have a testcase coverage for say
> fixed form:
> 
> C*OMP+PARALLEL DO
> do ...

That's going to be tricky. In fixed mode, the only way that we can tell
if there is an omp/acc continuation is by inspecting the character at
position 6. So, there could be a comment like

C*ACCELERATOR

which would get picked up as an acc continuation.

> (i.e. where it starts with an OpenMP (or OpenACC) continuation, without
> non-continued line first), or for free form where:
> 
> something &
> !$omp & parallel
> 
> (ditto for OpenACC).

What type of error should this be reporting? Right now it does report an
error because this gets expanded to

something parallel

That's clearly not correct. But at the same time, it would still be an
error if the user placed !$omp/acc between a continuation.

>> +	  while (gfc_is_whitespace (c));
>> +	  if (c != '\n' && c != '!')
>> +	    {
>> +	      /* Canonicalize to *$omp.  */
> 
> The comment has a pasto, by storing * you canonicalize to *$acc.

Fixed.

>> -	  if (flag_openacc)
>> +	  if (flag_openacc || (flag_openmp || flag_openmp_simd))
> 
> I'd just write
> 	if (flag_openacc || flag_openmp || flag_openmp_simd)
> the ()s around are just misleading.
> 
> Anyway, if the removal of "openmp_flag &&" is intentional, then
> the patch is ok with the above mentioned changes.  We can deal with the
> cases I've mentioned up above in a follow-up.

I'll apply this patch shortly.

Cesar

[-- Attachment #2: gfc_openmp-openacc.diff --]
[-- Type: text/x-patch, Size: 12897 bytes --]

2015-11-24  Ilmir Usmanov <me@ilmir.us>
	    Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/

	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.

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

diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index bfb7d45..8644119 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/gfortran.dg/goacc/omp-fixed.f b/gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
new file mode 100644
index 0000000..e715673
--- /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 24f639f..339438a 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

Re: [PR fortran/63858] Fix mix of OpenACC and OpenMP sentinels in continuations

[Bernhard Reutner-Fischer]

On November 25, 2015 3:33:47 PM GMT+01:00, Cesar Philippidis <cesar@codesourcery.com> wrote:
>On 10/20/2015 02:37 AM, Jakub Jelinek wrote:
>> On Fri, Oct 09, 2015 at 12:15:24PM +0200, Thomas Schwinge wrote:
>>> diff --git gcc/fortran/scanner.c gcc/fortran/scanner.c
>>> index bfb7d45..1e1ea84 100644
>>> --- gcc/fortran/scanner.c
>>> +++ gcc/fortran/scanner.c
>>> @@ -935,6 +935,63 @@ skip_free_comments (void)
>>>    return false;
>>>  }
>>>  
>>> +/* Return true if MP was matched in fixed form.  */
>>> +static bool
>>> +skip_omp_attribute_fixed (locus *start)
>> 
>> Technically, this isn't attribute, but sentinel.
>> So, skip_fixed_omp_sentinel?  I know the free functions
>> are called attribute, perhaps we should rename them too,
>> patch to do so preapproved.
>
>I've renamed those functions in this patch. The free variants are named
>skip_free_*_sentinel.
>
>>> +{
>>> +  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
>> 
>> The original code checked here
>> 	(openmp_flag && continue_flag)
>> instead.  Is that change intentional?
>
>I think so. Without it, continuations won't work with -fopenmp-simd.
>Note how that function call is guarded by
>
>  if ((flag_openmp || flag_openmp_simd) && !flag_openacc)
>
>> Looking around, we probably don't have a testcase coverage for say
>> fixed form:
>> 
>> C*OMP+PARALLEL DO
>> do ...
>
>That's going to be tricky. In fixed mode, the only way that we can tell
>if there is an omp/acc continuation is by inspecting the character at
>position 6. So, there could be a comment like
>
>C*ACCELERATOR
>
>which would get picked up as an acc continuation.
>
>> (i.e. where it starts with an OpenMP (or OpenACC) continuation,
>without
>> non-continued line first), or for free form where:
>> 
>> something &
>> !$omp & parallel
>> 
>> (ditto for OpenACC).
>
>What type of error should this be reporting? Right now it does report
>an
>error because this gets expanded to
>
>something parallel
>
>That's clearly not correct. But at the same time, it would still be an
>error if the user placed !$omp/acc between a continuation.
>
>>> +	  while (gfc_is_whitespace (c));

gfc_gobble_whitespace () ?
TIA,

PS: this thread has the relevant citations from the openmp standard, in case https://gcc.gnu.org/ml/fortran/2007-02/msg00312.html
I didn't look to see what acc says in this regard.

>>> +	  if (c != '\n' && c != '!')
>>> +	    {
>>> +	      /* Canonicalize to *$omp.  */
>> 
>> The comment has a pasto, by storing * you canonicalize to *$acc.
>
>Fixed.

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Ilmir Usmanov]

[-- Attachment #1: Type: text/plain, Size: 335 bytes --]

Fixed fortran mail-list address. Sorry for inconvenience.

08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
> Hi Cesar!
>
> This patch fixes checks of OpenMP and OpenACC continuations in case if someone mixes them (i.e. continues OpenMP directive with !$ACC sentinel or vice versa).
>
> OK for gomp branch?
>
> --
> Ilmir.

--
Ilmir.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch --]
[-- Type: text/x-diff; name="0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch", Size: 3749 bytes --]

From 5492bf5bc991b6924f5e3b35c11eeaed745df073 Mon Sep 17 00:00:00 2001
From: Ilmir Usmanov <i.usmanov@samsung.com>
Date: Sun, 7 Jun 2015 23:55:22 +0300
Subject: [PATCH] Fix mix of OpenACC and OpenMP sentinels in continuation

---
 gcc/fortran/ChangeLog                   |  5 +++++
 gcc/fortran/scanner.c                   | 28 ++++++++++++++++++++++++----
 gcc/testsuite/ChangeLog                 |  5 +++++
 gcc/testsuite/gfortran.dg/goacc/omp.f95 |  8 ++++++++
 4 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 67f9e09..f61e0e9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2015-06-07  Ilmir Usmanov  <me@ilmir.us>
+
+	* scanner.c (gfc_next_char_literal): Fix mix of OpenACC and OpenMP
+	sentinels in continuation.
+
 2015-05-05  David Malcolm  <dmalcolm@redhat.com>
 
 	* expr.c (check_inquiry): Fix indentation so that it reflects the
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index f0e6404..5af4eea 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1331,7 +1331,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;
@@ -1340,7 +1340,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;
@@ -1359,7 +1359,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 ())
 	    {
@@ -1370,7 +1370,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 ())
 	    {
@@ -1382,6 +1382,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 ("Wrong %s continuation at %C: expected %s, got %s",
+	             is_openmp ? "OpenACC" : "OpenMP",
+	             is_openmp ? "!$ACC" : "!$OMP",
+	             is_openmp ? "!$OMP" : "!$ACC");
+	}
+
       if (c != '&')
 	{
 	  if (in_string)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7c4781c..05a9a52 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-06-07  Ilmir Usmanov  <me@ilmir.us>
+
+	* gfortran.dg/goacc/omp.f95: Add mix of OpenACC and OpenMP
+	sentinels in continuation to test.
+
 2015-05-06  Yvan Roux  <yvan.roux@linaro.org>
 
 	PR target/64208
diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95
index 24f639f..a7333eb 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
+
+   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
\ No newline at end of file
-- 
1.9.1

Re: [gomp4, fortran] Patch to fix continuation checks of OpenACC and OpenMP directives

[Cesar Philippidis]

On 06/07/2015 02:05 PM, Ilmir Usmanov wrote:
> Fixed fortran mail-list address. Sorry for inconvenience.
> 
> 08.06.2015, 00:01, "Ilmir Usmanov" <me@ilmir.us>:
>>> Hi Cesar!
>>> 
>>> This patch fixes checks of OpenMP and OpenACC continuations in
>>> case if someone mixes them (i.e. continues OpenMP directive with
>>> !$ACC sentinel or vice versa).
>>> 
>>> OK for gomp branch?

Thanks for working on this. Does this fix PR63858 by any chance?

two minor nits...

> 0001-Fix-mix-of-OpenACC-and-OpenMP-sentinels-in-continuat.patch
> 
> 
> From 5492bf5bc991b6924f5e3b35c11eeaed745df073 Mon Sep 17 00:00:00 2001
> From: Ilmir Usmanov <i.usmanov@samsung.com>
> Date: Sun, 7 Jun 2015 23:55:22 +0300
> Subject: [PATCH] Fix mix of OpenACC and OpenMP sentinels in continuation
> 
> ---
>  gcc/fortran/ChangeLog                   |  5 +++++

Use ChangeLog.gomp for gomp-4_0-branch.

>  gcc/fortran/scanner.c                   | 28 ++++++++++++++++++++++++----
>  gcc/testsuite/ChangeLog                 |  5 +++++
>  gcc/testsuite/gfortran.dg/goacc/omp.f95 |  8 ++++++++
>  4 files changed, 42 insertions(+), 4 deletions(-)
> 
> diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
> index 67f9e09..f61e0e9 100644
> --- a/gcc/fortran/ChangeLog
> +++ b/gcc/fortran/ChangeLog
> @@ -1,3 +1,8 @@
> +2015-06-07  Ilmir Usmanov  <me@ilmir.us>
> +
> +	* scanner.c (gfc_next_char_literal): Fix mix of OpenACC and OpenMP
> +	sentinels in continuation.
> +
>  2015-05-05  David Malcolm  <dmalcolm@redhat.com>
>  
>  	* expr.c (check_inquiry): Fix indentation so that it reflects the
> diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
> index f0e6404..5af4eea 100644
> --- a/gcc/fortran/scanner.c
> +++ b/gcc/fortran/scanner.c
> @@ -1331,7 +1331,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;
> @@ -1340,7 +1340,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;
> @@ -1359,7 +1359,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 ())
>  	    {
> @@ -1370,7 +1370,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 ())
>  	    {
> @@ -1382,6 +1382,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 ("Wrong %s continuation at %C: expected %s, got %s",
> +	             is_openmp ? "OpenACC" : "OpenMP",
> +	             is_openmp ? "!$ACC" : "!$OMP",
> +	             is_openmp ? "!$OMP" : "!$ACC");

I think it's better for the translation project if you made this a
complete string. So maybe change this line into

  gfc_error (is_openmp ? "Wrong continuation at %C: expected !$ACC, got"
             " !$OMP",
             : "Wrong continuation at %C: expected !$OMP, got !$ACC");

Other than that, it looks fine.

Thanks,
Cesar