1! RUN: %S/test_errors.sh %s %t %f18 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 !ERROR: Left-hand side of assignment is not modifiable 34 y%i = 1 !VDC 35 type is (t2) 36 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable 37 call sub_with_in_and_inout_param(y,y) !VDC 38end select 39 40! B) associated with a variable: 41p_or_c => x1 42select type ( a => p_or_c ) 43 type is (t1) 44 a%i = 10 45end select 46 47select type ( a => p_or_c ) 48 type is (t1) 49end select 50 51!C)Associate with with vector subscript 52select type (b => array1(V,2)) 53 type is (t1) 54 !ERROR: Left-hand side of assignment is not modifiable 55 b%i = 1 !VDC 56 type is (t2) 57 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable 58 call sub_with_in_and_inout_param_vector(b,b) !VDC 59end select 60select type(b => foo(1) ) 61 type is (t1) 62 !ERROR: Left-hand side of assignment is not modifiable 63 b%i = 1 !VDC 64 type is (t2) 65 !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'z=' must be definable 66 call sub_with_in_and_inout_param_vector(b,b) !VDC 67end select 68 69!D) Have no association and should be ok. 70!1. points to function 71ptr => fun(1) 72select type ( ptr ) 73type is (t1) 74 ptr%i = 1 75end select 76 77!2. points to variable 78ptr=>x1 79select type (ptr) 80 type is (t1) 81 ptr%i = 10 82end select 83 84contains 85 86 function fun(i) 87 class(t1),pointer :: fun 88 integer :: i 89 if (i>0) then 90 fun => x1 91 else if (i<0) then 92 fun => x2 93 else 94 fun => NULL() 95 end if 96 end function 97 98 function foo(i) 99 integer :: i 100 class(t1),DIMENSION(:),allocatable :: foo 101 integer, dimension(2) :: U 102 U = (/ 1,2 /) 103 if (i>0) then 104 foo = array1(2,U) 105 else if (i<0) then 106 !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(t1) and TYPE(t2) 107 foo = array2(2,U) 108 end if 109 end function 110 111 subroutine sub_with_in_and_inout_param(y, z) 112 type(t2), INTENT(IN) :: y 113 class(t2), INTENT(INOUT) :: z 114 z%i = 10 115 end subroutine 116 117 subroutine sub_with_in_and_inout_param_vector(y, z) 118 type(t2),DIMENSION(:), INTENT(IN) :: y 119 class(t2),DIMENSION(:), INTENT(INOUT) :: z 120 z%i = 10 121 end subroutine 122 123end 124