re PR fortran/63858 (fixed form OpenACC directive ICE with -fopenacc -fopenmp)

	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.

Co-Authored-By: Cesar Philippidis <cesar@codesourcery.com>
From-SVN: r230872

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index adc39bb5b8c0eac19bfe5ae5c05e3da15b0a3128..da29a9d8f42058e7e70fed74ed778ee6a36731c2 100644 (file)
--- 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 bfb7d452e9040136de5f8a35e5a85f7b18301883..86441199b4623dcecb07f1de0e72e4b1eb233daa 100644 (file)
--- 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 47ed2acef54596bbac0ee44bc058b9ceeb7a4bb2..58bd40ab40432adc4ef75ca1aea3fc3340c21ddc 100644 (file)
--- 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 (file)
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 24f639ff54a25d7c79b42ae0f5aa3e5c48bb524a..339438ab7728d8e68afdf558a308f0aa3339a232 100644 (file)
--- 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