111
|
1 ! { dg-do compile }
|
|
2 ! { dg-options "-fcoarray=single" }
|
|
3 !
|
|
4 !
|
|
5 ! LOCK/LOCK_TYPE checks
|
|
6 !
|
|
7 subroutine extends()
|
|
8 use iso_fortran_env
|
|
9 type t
|
|
10 end type t
|
|
11 type, extends(t) :: t2 ! { dg-error "coarray component, parent type .t. shall also have one" }
|
|
12 type(lock_type), allocatable :: c(:)[:]
|
|
13 end type t2
|
|
14 end subroutine extends
|
|
15
|
|
16 module m
|
|
17 use iso_fortran_env
|
|
18
|
|
19 type t
|
|
20 type(lock_type), allocatable :: x(:)[:]
|
|
21 end type t
|
|
22 end module m
|
|
23
|
|
24 module 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
|
|
29 end module m2
|
|
30
|
|
31 module m3
|
|
32 use iso_fortran_env
|
|
33 type t3
|
|
34 type(lock_type) :: x ! OK
|
|
35 end type t3
|
|
36 end module m3
|
|
37
|
|
38 subroutine sub(x)
|
|
39 use iso_fortran_env
|
|
40 type(lock_type), intent(out) :: x[*] ! OK
|
|
41 end subroutine sub
|
|
42
|
|
43 subroutine 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(:)[:]
|
|
46 end subroutine sub1
|
|
47
|
|
48 subroutine 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
|
|
51 end subroutine sub2
|
|
52
|
|
53 subroutine sub3(x) ! { dg-error "with coarray component shall be a nonpointer, nonallocatable scalar" }
|
|
54 use m
|
|
55 type(t), intent(inout) :: x[*]
|
|
56 end subroutine sub3
|
|
57
|
|
58 subroutine sub4(x)
|
|
59 use m3
|
|
60 type(t3), intent(inout) :: x[*] ! OK
|
|
61 end subroutine sub4
|
|
62
|
|
63 subroutine 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" }
|
|
68 end subroutine lock_test
|
|
69
|
|
70 subroutine 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
|
|
83 end subroutine lock_test2
|
|
84
|
|
85
|
|
86 subroutine 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" }
|
|
92 end subroutine lock_test3
|
|
93
|
|
94
|
|
95 subroutine 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)
|
|
103 end subroutine lock_test4
|
|
104
|
|
105
|
|
106 subroutine 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" }
|
|
111 contains
|
|
112 subroutine test(x)
|
|
113 type(lock_type), intent(in) :: x[*]
|
|
114 end subroutine test
|
|
115 end subroutine argument_check
|