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