Dead
[official-gcc.git] / gomp-20050608-branch / libgomp / testsuite / libgomp.fortran / vla7.f90
blob29a6696443a8b16ec6518e41a9f7d4ca75da32e4
1 ! { dg-do run }
2 ! { dg-options "-w" }
4 character (6) :: c, f2
5 character (6) :: d(2)
6 c = f1 (6)
7 if (c .ne. 'opqrst') call abort
8 c = f2 (6)
9 if (c .ne. '_/!!/_') call abort
10 d = f3 (6)
11 if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
12 d = f4 (6)
13 if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
14 contains
15 function f1 (n)
16 use omp_lib
17 character (n) :: f1
18 logical :: l
19 f1 = 'abcdef'
20 l = .false.
21 !$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
22 l = f1 .ne. 'abcdef'
23 if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
24 if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
25 !$omp barrier
26 l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
27 l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
28 !$omp end parallel
29 f1 = 'zZzz_z'
30 !$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
31 l = l .or. f1 .ne. 'zZzz_z'
32 !$omp barrier
33 !$omp master
34 f1 = 'abc'
35 !$omp end master
36 !$omp barrier
37 l = l .or. f1 .ne. 'abc'
38 !$omp barrier
39 if (omp_get_thread_num () .eq. 1) f1 = 'def'
40 !$omp barrier
41 l = l .or. f1 .ne. 'def'
42 !$omp end parallel
43 if (l) call abort
44 f1 = 'opqrst'
45 end function f1
46 function f3 (n)
47 use omp_lib
48 character (n), dimension (2) :: f3
49 logical :: l
50 f3 = 'abcdef'
51 l = .false.
52 !$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
53 l = any (f3 .ne. 'abcdef')
54 if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
55 if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
56 !$omp barrier
57 l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
58 l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
59 !$omp end parallel
60 f3 = 'zZzz_z'
61 !$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
62 l = l .or. any (f3 .ne. 'zZzz_z')
63 !$omp barrier
64 !$omp master
65 f3 = 'abc'
66 !$omp end master
67 !$omp barrier
68 l = l .or. any (f3 .ne. 'abc')
69 !$omp barrier
70 if (omp_get_thread_num () .eq. 1) f3 = 'def'
71 !$omp barrier
72 l = l .or. any (f3 .ne. 'def')
73 !$omp end parallel
74 if (l) call abort
75 f3(1) = 'opqrst'
76 f3(2) = 'a'
77 end function f3
78 function f4 (n)
79 use omp_lib
80 character (n), dimension (n - 4) :: f4
81 logical :: l
82 f4 = 'abcdef'
83 l = .false.
84 !$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
85 l = any (f4 .ne. 'abcdef')
86 if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
87 if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
88 !$omp barrier
89 l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
90 l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
91 l = l .or. size (f4) .ne. 2
92 !$omp end parallel
93 f4 = 'zZzz_z'
94 !$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
95 l = l .or. any (f4 .ne. 'zZzz_z')
96 !$omp barrier
97 !$omp master
98 f4 = 'abc'
99 !$omp end master
100 !$omp barrier
101 l = l .or. any (f4 .ne. 'abc')
102 !$omp barrier
103 if (omp_get_thread_num () .eq. 1) f4 = 'def'
104 !$omp barrier
105 l = l .or. any (f4 .ne. 'def')
106 l = l .or. size (f4) .ne. 2
107 !$omp end parallel
108 if (l) call abort
109 f4(1) = 'Opqrst'
110 f4(2) = 'A'
111 end function f4
113 function f2 (n)
114 use omp_lib
115 character (*) :: f2
116 logical :: l
117 f2 = 'abcdef'
118 l = .false.
119 !$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
120 l = f2 .ne. 'abcdef'
121 if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
122 if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
123 !$omp barrier
124 l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
125 l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
126 !$omp end parallel
127 f2 = 'zZzz_z'
128 !$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
129 l = l .or. f2 .ne. 'zZzz_z'
130 !$omp barrier
131 !$omp master
132 f2 = 'abc'
133 !$omp end master
134 !$omp barrier
135 l = l .or. f2 .ne. 'abc'
136 !$omp barrier
137 if (omp_get_thread_num () .eq. 1) f2 = 'def'
138 !$omp barrier
139 l = l .or. f2 .ne. 'def'
140 !$omp end parallel
141 if (l) call abort
142 f2 = '_/!!/_'
143 end function f2