parse.c (case_decl): Move ST_OMP_* to ...
authorJakub Jelinek <jakub@redhat.com>
Wed, 1 Jun 2016 12:21:38 +0000 (14:21 +0200)
committerJakub Jelinek <jakub@gcc.gnu.org>
Wed, 1 Jun 2016 12:21:38 +0000 (14:21 +0200)
* parse.c (case_decl): Move ST_OMP_* to ...
(case_omp_decl): ... here, new macro.
(verify_st_order): For case_omp_decl, complain about
p->state >= ORDER_EXEC, but don't change p->state otherwise.

* gfortran.dg/gomp/order-1.f90: New test.
* gfortran.dg/gomp/order-2.f90: New test.

From-SVN: r236987

gcc/fortran/ChangeLog
gcc/fortran/parse.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/gomp/order-1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/gomp/order-2.f90 [new file with mode: 0644]

index 73235c6d31cd80e7a1d0ceaab183d7484df92f15..8cff148fa979885d835af1c3173ccb98f07cb72b 100644 (file)
@@ -1,3 +1,10 @@
+2016-06-01  Jakub Jelinek  <jakub@redhat.com>
+
+       * parse.c (case_decl): Move ST_OMP_* to ...
+       (case_omp_decl): ... here, new macro.
+       (verify_st_order): For case_omp_decl, complain about
+       p->state >= ORDER_EXEC, but don't change p->state otherwise.
+
 2016-05-26  Jakub Jelinek  <jakub@redhat.com>
 
        * openmp.c (resolve_omp_clauses): Warn if chunk_size is known not to
index dd7aa6a4e13b23531a226bdd547e732eddff0596..1081b2e605e35ff064ad1150cc021439b7646afd 100644 (file)
@@ -1390,9 +1390,13 @@ next_statement (void)
 
 #define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
   case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
-  case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \
-  case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \
-  case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
+  case ST_TYPE: case ST_INTERFACE: case ST_PROCEDURE: case ST_OACC_ROUTINE: \
+  case ST_OACC_DECLARE
+
+/* OpenMP declaration statements.  */
+
+#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
+  case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION
 
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
@@ -2488,6 +2492,14 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
        p->state = ORDER_SPEC;
       break;
 
+    case_omp_decl:
+      /* The OpenMP directives have to be somewhere in the specification
+        part, but there are no further requirements on their ordering.
+        Thus don't adjust p->state, just ignore them.  */
+      if (p->state >= ORDER_EXEC)
+       goto order;
+      break;
+
     case_executable:
     case_exec_markers:
       if (p->state < ORDER_EXEC)
@@ -3563,6 +3575,7 @@ loop:
     case ST_STRUCTURE_DECL:
     case ST_DERIVED_DECL:
     case_decl:
+    case_omp_decl:
 declSt:
       if (!verify_st_order (&ss, st, false))
        {
index 75d8504da76281dd67a4bf3f4c57914e07a1c3fd..1efe0e1bb4a28d0894e863d170bbdac92a0e8a4e 100644 (file)
@@ -1,3 +1,8 @@
+2016-06-01  Jakub Jelinek  <jakub@redhat.com>
+
+       * gfortran.dg/gomp/order-1.f90: New test.
+       * gfortran.dg/gomp/order-2.f90: New test.
+
 2016-06-01  Jan Hubicka  <hubicka@ucw.cz>
 
        * gcc.dg/unroll-6.c: Update template.
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-1.f90 b/gcc/testsuite/gfortran.dg/gomp/order-1.f90
new file mode 100644 (file)
index 0000000..23db74c
--- /dev/null
@@ -0,0 +1,92 @@
+! { dg-do compile }
+
+module m
+  integer :: i
+end module m
+subroutine f1
+  type t
+    integer :: i
+  end type t
+  interface
+    integer function f3 (a, b)
+      !$omp declare simd (f3) uniform (a)
+      use m
+      import :: t
+      implicit none
+      type (t) :: a
+      integer :: b
+    end function f3
+  end interface
+  interface
+    integer function f4 (a, b)
+      use m
+      !$omp declare simd (f4) uniform (a)
+      import :: t
+      implicit none
+      type (t) :: a
+      integer :: b
+    end function f4
+  end interface
+  interface
+    integer function f5 (a, b)
+      use m
+      import :: t
+      !$omp declare simd (f5) uniform (a)
+      implicit none
+      type (t) :: a
+      integer :: b
+    end function f5
+  end interface
+  interface
+    integer function f6 (a, b)
+      use m
+      import :: t
+      implicit none
+      !$omp declare simd (f6) uniform (a)
+      type (t) :: a
+      integer :: b
+    end function f6
+  end interface
+  interface
+    integer function f7 (a, b)
+      use m
+      import :: t
+      implicit none
+      type (t) :: a
+      !$omp declare simd (f7) uniform (a)
+      integer :: b
+    end function f7
+  end interface
+  call f2
+contains
+  subroutine f2
+    !$omp threadprivate (t1)
+    use m
+    !$omp threadprivate (t2)
+    implicit none
+    !$omp threadprivate (t3)
+    integer, save :: t1, t2, t3, t4
+    !$omp threadprivate (t4)
+    t1 = 1; t2 = 2; t3 = 3; t4 = 4
+  end subroutine f2
+  subroutine f8
+    !$omp declare reduction (f8_1:real:omp_out = omp_out + omp_in)
+    use m
+    !$omp declare reduction (f8_2:real:omp_out = omp_out + omp_in)
+    implicit none
+    !$omp declare reduction (f8_3:real:omp_out = omp_out + omp_in)
+    integer :: j
+    !$omp declare reduction (f8_4:real:omp_out = omp_out + omp_in)
+  end subroutine f8
+  subroutine f9
+    !$omp declare target (f9_1)
+    use m
+    !$omp declare target (f9_2)
+    implicit none
+    !$omp declare target (f9_3)
+    !$omp declare target
+    integer, save :: f9_1, f9_2, f9_3, f9_4
+    !$omp declare target (f9_4)
+    f9_1 = 1; f9_2 = 2; f9_3 = 3; f9_4 = 4
+  end subroutine f9
+end subroutine f1
diff --git a/gcc/testsuite/gfortran.dg/gomp/order-2.f90 b/gcc/testsuite/gfortran.dg/gomp/order-2.f90
new file mode 100644 (file)
index 0000000..4ee3a82
--- /dev/null
@@ -0,0 +1,37 @@
+! { dg-do compile }
+
+module m
+  integer :: i
+end module m
+subroutine f1
+  call f2
+contains
+  subroutine f2
+    use m
+    implicit none
+    integer, save :: t
+    t = 1
+    !$omp threadprivate (t1)   ! { dg-error "Unexpected" }
+  end subroutine f2
+  subroutine f3
+    use m
+    implicit none
+    integer :: j
+    j = 1
+    !$omp declare reduction (foo:real:omp_out = omp_out + omp_in)      ! { dg-error "Unexpected" }
+  end subroutine f3
+  subroutine f4
+    use m
+    implicit none
+    !$omp declare target
+    integer, save :: f4_1
+    f4_1 = 1
+    !$omp declare target (f4_1)        ! { dg-error "Unexpected" }
+    !$omp declare target       ! { dg-error "Unexpected" }
+  end subroutine f4
+  integer function f5 (a, b)
+    integer :: a, b
+    a = 1; b = 2
+    !$omp declare simd (f5) notinbranch        ! { dg-error "Unexpected" }
+  end function f5
+end subroutine f1