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