1! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
2
3! Check OpenMP declarative directives
4
5!TODO: all internal errors
6!      enable declare-reduction example after name resolution
7
8! 2.8.2 declare-simd
9
10subroutine declare_simd_1(a, b)
11  real(8), intent(inout) :: a, b
12  !ERROR: Internal: no symbol found for 'declare_simd_1'
13  !ERROR: Internal: no symbol found for 'a'
14  !$omp declare simd(declare_simd_1) aligned(a)
15  a = 3.14 + b
16end subroutine declare_simd_1
17
18module m1
19  abstract interface
20     subroutine sub(x,y)
21       integer, intent(in)::x
22       integer, intent(in)::y
23     end subroutine sub
24  end interface
25end module m1
26
27subroutine declare_simd_2
28  use m1
29  procedure (sub) sub1
30  !ERROR: Internal: no symbol found for 'sub1'
31  !ERROR: NOTINBRANCH and INBRANCH are mutually exclusive and may not appear on the same DECLARE SIMD directive
32  !$omp declare simd(sub1) inbranch notinbranch
33  procedure (sub), pointer::p
34  p=>sub1
35  call p(5,10)
36end subroutine declare_simd_2
37
38subroutine sub1 (x,y)
39  integer, intent(in)::x, y
40  print *, x+y
41end subroutine sub1
42
43! 2.10.6 declare-target
44! 2.15.2 threadprivate
45
46module m2
47contains
48  subroutine foo
49    !$omp declare target
50    !$omp declare target (foo, N, M)
51    !$omp declare target to(Q, S) link(R)
52    !ERROR: MAP clause is not allowed on the DECLARE TARGET directive
53    !$omp declare target map(from:Q)
54    integer, parameter :: N=10000, M=1024
55    integer :: i
56    real :: Q(N, N), R(N,M), S(M,M)
57    !$omp threadprivate(i)
58  end subroutine foo
59end module m2
60
61! 2.16 declare-reduction
62
63! subroutine declare_red_1()
64!   use omp_lib
65!   integer :: my_var
66!   !$omp declare reduction (my_add_red : integer : omp_out = omp_out + omp_in) initializer (omp_priv=0)
67!   my_var = 0
68!   !$omp parallel reduction (my_add_red : my_var) num_threads(4)
69!   my_var = omp_get_thread_num() + 1
70!   !$omp end parallel
71!   print *, "sum of thread numbers is ", my_var
72! end subroutine declare_red_1
73
74end
75