1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3!
4!
5! LOCK/LOCK_TYPE checks
6!
7subroutine extends()
8use iso_fortran_env
9type t
10end type t
11type, extends(t) :: t2 ! { dg-error "coarray component, parent type .t. shall also have one" }
12  type(lock_type), allocatable :: c(:)[:]
13end type t2
14end subroutine extends
15
16module m
17  use iso_fortran_env
18
19  type t
20    type(lock_type), allocatable :: x(:)[:]
21  end type t
22end module m
23
24module m2
25  use iso_fortran_env
26  type t2
27    type(lock_type), allocatable :: x ! { dg-error "Allocatable component x at .1. of type LOCK_TYPE must have a codimension" }
28  end type t2
29end module m2
30
31module m3
32  use iso_fortran_env
33  type t3
34    type(lock_type) :: x ! OK
35  end type t3
36end module m3
37
38subroutine sub(x)
39  use iso_fortran_env
40  type(lock_type), intent(out) :: x[*] ! OK
41end subroutine sub
42
43subroutine sub1(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
44  use iso_fortran_env
45  type(lock_type), allocatable, intent(out) :: x(:)[:]
46end subroutine sub1
47
48subroutine sub2(x) ! { dg-error "is INTENT.OUT. and can thus not be an allocatable coarray or have coarray components" }
49  use m
50  type(t), intent(out) :: x
51end subroutine sub2
52
53subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, nonallocatable scalar" }
54  use m
55  type(t), intent(inout) :: x[*]
56end subroutine sub3
57
58subroutine sub4(x)
59  use m3
60  type(t3), intent(inout) :: x[*] ! OK
61end subroutine sub4
62
63subroutine lock_test
64  use iso_fortran_env
65  type t
66  end type t
67  type(lock_type) :: lock ! { dg-error "of type LOCK_TYPE or with subcomponent of type LOCK_TYPE must be a coarray" }
68end subroutine lock_test
69
70subroutine lock_test2
71  use iso_fortran_env
72  implicit none
73  type t
74  end type t
75  type(t) :: x
76  type(lock_type), save :: lock[*],lock2(2)[*]
77  lock(t) ! { dg-error "Syntax error in LOCK statement" }
78  lock(x) ! { dg-error "must be a scalar of type LOCK_TYPE" }
79  lock(lock)
80  lock(lock2(1))
81  lock(lock2) ! { dg-error "must be a scalar of type LOCK_TYPE" }
82  lock(lock[1]) ! OK
83end subroutine lock_test2
84
85
86subroutine lock_test3
87  use iso_fortran_env
88  type(lock_type), save :: a[*], b[*]
89  a = b ! { dg-error "LOCK_TYPE in variable definition context" }
90  b = lock_type() ! { dg-error "LOCK_TYPE in variable definition context" }
91  print *, a ! { dg-error "cannot have PRIVATE components" }
92end subroutine lock_test3
93
94
95subroutine lock_test4
96  use iso_fortran_env
97  type(lock_type), allocatable :: A(:)[:]
98  logical :: ob
99  allocate(A(1)[*])
100  lock(A(1), acquired_lock=ob)
101  unlock(A(1))
102  deallocate(A)
103end subroutine lock_test4
104
105
106subroutine argument_check()
107  use iso_fortran_env
108  type(lock_type), SAVE :: ll[*]
109  call no_interface(ll) ! { dg-error "Actual argument of LOCK_TYPE or with LOCK_TYPE component at .1. requires an explicit interface" }
110  call test(ll) ! { dg-error "non-INTENT.INOUT. dummy .x. at .1., which is LOCK_TYPE or has a LOCK_TYPE component" }
111contains
112  subroutine test(x)
113    type(lock_type), intent(in) :: x[*]
114  end subroutine test
115end subroutine argument_check
116