Fortran: Fix OpenMP/OpenACC continue-line parsing
authorTobias Burnus <tobias@codesourcery.com>
Fri, 4 Jun 2021 15:43:59 +0000 (17:43 +0200)
committerTobias Burnus <tobias@codesourcery.com>
Fri, 4 Jun 2021 15:44:23 +0000 (17:44 +0200)
gcc/fortran/ChangeLog:

* scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if
this is not an (OpenMP) continuation line.
(skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC.
(gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC
continuation once per location and return '\n'.

gcc/testsuite/ChangeLog:

* gfortran.dg/goacc/omp-fixed.f: Re-add test item changed in previous
commit in addition - add more dg-errors and '... end ...' due to changed
parsing.
* gfortran.dg/goacc/omp.f95: Likewise.
* gfortran.dg/goacc-gomp/mixed-1.f: New test.

gcc/fortran/scanner.c
gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f [new file with mode: 0644]
gcc/testsuite/gfortran.dg/goacc/omp-fixed.f
gcc/testsuite/gfortran.dg/goacc/omp.f95

index 74c5461..39db099 100644 (file)
@@ -942,6 +942,8 @@ skip_fixed_omp_sentinel (locus *start)
          && (continue_flag
              || c == ' ' || c == '\t' || c == '0'))
        {
+         if (c == ' ' || c == '\t' || c == '0')
+           openacc_flag = 0;
          do
            c = next_char ();
          while (gfc_is_whitespace (c));
@@ -971,6 +973,8 @@ skip_fixed_oacc_sentinel (locus *start)
          && (continue_flag
              || c == ' ' || c == '\t' || c == '0'))
        {
+         if (c == ' ' || c == '\t' || c == '0')
+           openmp_flag = 0;
          do
            c = next_char ();
          while (gfc_is_whitespace (c));
@@ -1205,6 +1209,7 @@ gfc_skip_comments (void)
 gfc_char_t
 gfc_next_char_literal (gfc_instring in_string)
 {
+  static locus omp_acc_err_loc = {};
   locus old_loc;
   int i, prev_openmp_flag, prev_openacc_flag;
   gfc_char_t c;
@@ -1403,14 +1408,16 @@ restart:
            {
              if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i])
                is_openmp = 1;
-             if (i == 4)
-               old_loc = gfc_current_locus;
            }
-         gfc_error (is_openmp
-                    ? G_("Wrong OpenACC continuation at %C: "
-                         "expected !$ACC, got !$OMP")
-                    : G_("Wrong OpenMP continuation at %C: "
-                         "expected !$OMP, got !$ACC"));
+         if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
+             || omp_acc_err_loc.lb != gfc_current_locus.lb)
+           gfc_error_now (is_openmp
+                          ? G_("Wrong OpenACC continuation at %C: "
+                               "expected !$ACC, got !$OMP")
+                          : G_("Wrong OpenMP continuation at %C: "
+                               "expected !$OMP, got !$ACC"));
+         omp_acc_err_loc = gfc_current_locus;
+         goto not_continuation;
        }
 
       if (c != '&')
@@ -1511,11 +1518,15 @@ restart:
              if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
                is_openmp = 1;
            }
-         gfc_error (is_openmp
-                    ? G_("Wrong OpenACC continuation at %C: "
-                         "expected !$ACC, got !$OMP")
-                    : G_("Wrong OpenMP continuation at %C: "
-                         "expected !$OMP, got !$ACC"));
+         if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
+             || omp_acc_err_loc.lb != gfc_current_locus.lb)
+           gfc_error_now (is_openmp
+                          ? G_("Wrong OpenACC continuation at %C: "
+                               "expected !$ACC, got !$OMP")
+                          : G_("Wrong OpenMP continuation at %C: "
+                               "expected !$OMP, got !$ACC"));
+         omp_acc_err_loc = gfc_current_locus;
+         goto not_continuation;
        }
       else if (!openmp_flag && !openacc_flag)
        for (i = 0; i < 5; i++)
diff --git a/gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f b/gcc/testsuite/gfortran.dg/goacc-gomp/mixed-1.f
new file mode 100644 (file)
index 0000000..2e12f17
--- /dev/null
@@ -0,0 +1,23 @@
+! { dg-additional-options "-fdump-tree-original" }
+
+      ! OMP PARALLEL gets parsed  and is properly handled
+      ! But ACC& gives an error
+      ! [Before: an error is printed but OMP parses 'parallel loop ...']
+      subroutine one
+        implicit none
+        integer i
+!$omp parallel
+!$acc& loop independent  !  { dg-error "Wrong OpenMP continuation at .1.: expected !.OMP, got !.ACC" }
+        do i = 1, 5
+        end do
+!$omp end parallel
+      end
+
+      ! [Before: Bogus 'Wrong OpenMP continuation' as it was read as continuation line!]
+      subroutine two
+!$omp parallel
+!$acc loop independent  !  { dg-error "The !.ACC LOOP directive cannot be specified within a !.OMP PARALLEL region" }
+       do i = 1, 5
+       end do
+!$omp end parallel
+       end
index 6ce6f73..b1e7aff 100644 (file)
@@ -6,7 +6,7 @@
 
 !$OMP PARALLEL
 !$ACC PARALLEL                                                          &
-!$ACC& COPYIN(ARGC) ! { dg-error "directive cannot be specified within" }
+!$ACC& COPYIN(ARGC)  ! { dg-error "The !.ACC PARALLEL directive cannot be specified within a !.OMP PARALLEL region" }
       IF (ARGC .NE. 0) THEN
          STOP 1
       END IF
 !$OMP& DO ! { dg-error "Wrong OpenACC continuation" }
       DO I = 1, 10
       ENDDO
+!$ACC END PARALLEL
 
 !$OMP PARALLEL                                                          &
 !$ACC& KERNELS LOOP ! { dg-error "Wrong OpenMP continuation" }
       DO I = 1, 10
       ENDDO
+!$OMP END PARALLEL
+
+!$OMP PARALLEL                                                          &
+!$ACC& LOOP ! { dg-error "Wrong OpenMP continuation" }
+      DO I = 1, 10
+      ENDDO
+!$OMP END PARALLEL
       END SUBROUTINE NI
index 8b3b259..d8bd886 100644 (file)
@@ -67,8 +67,20 @@ contains
    subroutine nana
      !$acc parallel &
      !$omp do ! { dg-error "Wrong OpenACC continuation" }
+     do i = 1, 5 ! { dg-error "The !.OMP DO directive cannot be specified within a !.ACC PARALLEL region" "" { target *-*-* } .-1 }
+     end do
+     !$acc end parallel
 
      !$omp parallel &
      !$acc kernels loop ! { dg-error "Wrong OpenMP continuation" }
+     do i = 1, 5 ! { dg-error "The !.ACC KERNELS LOOP directive cannot be specified within a !.OMP PARALLEL region" "" { target *-*-* } .-1 }
+     end do
+     !$omp end parallel
+
+     !$omp parallel &
+     !$acc loop ! { dg-error "Wrong OpenMP continuation" }
+     do i = 1, 5 ! { dg-error "The !.ACC LOOP directive cannot be specified within a !.OMP PARALLEL region" "" { target *-*-* } .-1 }
+     end do
+     !$omp end parallel
    end subroutine nana
 end module test