1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Test various conditions in C1158.
implicit none
type :: t1
integer :: i
end type
type, extends(t1) :: t2
end type
type(t1),target :: x1
type(t2),target :: x2
class(*), pointer :: ptr
class(t1), pointer :: p_or_c
!vector subscript related
class(t1),DIMENSION(:,:),allocatable::array1
class(t2),DIMENSION(:,:),allocatable::array2
integer, dimension(2) :: V
V = (/ 1,2 /)
allocate(array1(3,3))
allocate(array2(3,3))
! A) associate with function, i.e (other than variables)
select type ( y => fun(1) )
type is (t1)
print *, rank(y%i)
end select
select type ( y => fun(1) )
type is (t1)
y%i = 1 !VDC
type is (t2)
call sub_with_in_and_inout_param(y,y) !VDC
end select
select type ( y => (fun(1)) )
type is (t1)
!ERROR: Left-hand side of assignment is not definable
!BECAUSE: 'y' is construct associated with an expression
y%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
!BECAUSE: 'y' is construct associated with an expression
call sub_with_in_and_inout_param(y,y) !VDC
end select
! B) associated with a variable:
p_or_c => x1
select type ( a => p_or_c )
type is (t1)
a%i = 10
end select
select type ( a => p_or_c )
type is (t1)
end select
!C)Associate with with vector subscript
select type (b => array1(V,2))
type is (t1)
!ERROR: Left-hand side of assignment is not definable
!BECAUSE: Construct association 'b' has a vector subscript
b%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
!BECAUSE: Variable 'b' has a vector subscript
call sub_with_in_and_inout_param_vector(b,b) !VDC
end select
select type(b => foo(1) )
type is (t1)
!ERROR: Left-hand side of assignment is not definable
!BECAUSE: 'b' is construct associated with an expression
b%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' is not definable
!BECAUSE: 'b' is construct associated with an expression
call sub_with_in_and_inout_param_vector(b,b) !VDC
end select
!D) Have no association and should be ok.
!1. points to function
ptr => fun(1)
select type ( ptr )
type is (t1)
ptr%i = 1
end select
!2. points to variable
ptr=>x1
select type (ptr)
type is (t1)
ptr%i = 10
end select
contains
function fun(i)
class(t1),pointer :: fun
integer :: i
if (i>0) then
fun => x1
else if (i<0) then
fun => x2
else
fun => NULL()
end if
end function
function foo(i)
integer :: i
class(t1),DIMENSION(:),allocatable :: foo
integer, dimension(2) :: U
U = (/ 1,2 /)
if (i>0) then
foo = array1(2,U)
else if (i<0) then
foo = array2(2,U) ! ok: t2 extends t1
end if
end function
function foo2()
class(t2),DIMENSION(:),allocatable :: foo2
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types CLASS(t2) and CLASS(t1)
foo2 = array1(2,:)
end function
subroutine sub_with_in_and_inout_param(y, z)
type(t2), INTENT(IN) :: y
class(t2), INTENT(INOUT) :: z
z%i = 10
end subroutine
subroutine sub_with_in_and_inout_param_vector(y, z)
type(t2),DIMENSION(:), INTENT(IN) :: y
class(t2),DIMENSION(:), INTENT(INOUT) :: z
z%i = 10
end subroutine
end
|
