1! { dg-do run }
2!
3! LOCK/UNLOCK check
4!
5! PR fortran/18918
6!
7
8use iso_fortran_env
9implicit none
10
11type(lock_type), allocatable :: lock1[:]
12type(lock_type), allocatable :: lock2(:,:)[:]
13type(lock_type) :: lock3(4)[*]
14integer :: stat
15logical :: acquired
16
17allocate(lock1[*])
18allocate(lock2(2,2)[*])
19
20LOCK(lock1)
21UNLOCK(lock1)
22
23LOCK(lock2(1,1))
24LOCK(lock2(2,2))
25UNLOCK(lock2(1,1))
26UNLOCK(lock2(2,2))
27
28LOCK(lock3(3))
29LOCK(lock3(4))
30UNLOCK(lock3(3))
31UNLOCK(lock3(4))
32
33stat = 99
34LOCK(lock1, stat=stat)
35if (stat /= 0) STOP 1
36
37LOCK(lock2(1,1), stat=stat)
38if (stat /= 0) STOP 2
39LOCK(lock2(2,2), stat=stat)
40if (stat /= 0) STOP 3
41
42LOCK(lock3(3), stat=stat)
43if (stat /= 0) STOP 4
44LOCK(lock3(4), stat=stat)
45if (stat /= 0) STOP 5
46
47stat = 99
48UNLOCK(lock1, stat=stat)
49if (stat /= 0) STOP 6
50
51UNLOCK(lock2(1,1), stat=stat)
52if (stat /= 0) STOP 7
53UNLOCK(lock2(2,2), stat=stat)
54if (stat /= 0) STOP 8
55
56UNLOCK(lock3(3), stat=stat)
57if (stat /= 0) STOP 9
58UNLOCK(lock3(4), stat=stat)
59if (stat /= 0) STOP 10
60
61if (this_image() == 1) then
62  acquired = .false.
63  LOCK (lock1[this_image()], acquired_lock=acquired)
64  if (.not. acquired) STOP 11
65
66  acquired = .false.
67  LOCK (lock2(1,1)[this_image()], acquired_lock=acquired)
68  if (.not. acquired) STOP 12
69
70  acquired = .false.
71  LOCK (lock2(2,2)[this_image()], acquired_lock=acquired)
72  if (.not. acquired) STOP 13
73
74  acquired = .false.
75  LOCK (lock3(3)[this_image()], acquired_lock=acquired)
76  if (.not. acquired) STOP 14
77
78  acquired = .false.
79  LOCK (lock3(4)[this_image()], acquired_lock=acquired)
80  if (.not. acquired) STOP 15
81
82  UNLOCK (lock1[1])
83  UNLOCK (lock2(1,1)[1])
84  UNLOCK (lock2(2,2)[1])
85  UNLOCK (lock3(3)[1])
86  UNLOCK (lock3(4)[1])
87end if
88end
89
90