Fix build on sparc64-linux-gnu.
[official-gcc.git] / libgomp / testsuite / libgomp.fortran / procptr1.f90
blob560d0da421636c877871db41eb219c2ca5fd9925
1 ! { dg-do run }
2 interface
3 integer function foo ()
4 end function
5 integer function bar ()
6 end function
7 integer function baz ()
8 end function
9 end interface
10 procedure(foo), pointer :: ptr
11 integer :: i
12 ptr => foo
13 !$omp parallel shared (ptr)
14 if (ptr () /= 1) STOP 1
15 !$omp end parallel
16 ptr => bar
17 !$omp parallel firstprivate (ptr)
18 if (ptr () /= 2) STOP 2
19 !$omp end parallel
20 !$omp parallel sections lastprivate (ptr)
21 !$omp section
22 ptr => foo
23 if (ptr () /= 1) STOP 3
24 !$omp section
25 ptr => bar
26 if (ptr () /= 2) STOP 4
27 !$omp section
28 ptr => baz
29 if (ptr () /= 3) STOP 5
30 !$omp end parallel sections
31 if (ptr () /= 3) STOP 6
32 if (.not.associated (ptr, baz)) STOP 7
33 end
34 integer function foo ()
35 foo = 1
36 end function
37 integer function bar ()
38 bar = 2
39 end function
40 integer function baz ()
41 baz = 3
42 end function