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
|
! RUN: %S/test_errors.sh %s %t %flang_fc1
! REQUIRES: shell
! 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)
!ERROR: Left-hand side of assignment is not modifiable
y%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
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 modifiable
b%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
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 modifiable
b%i = 1 !VDC
type is (t2)
!ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable
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
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t2)
foo = array2(2,U)
end if
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
|
