1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Test restrictions on what subprograms can be used for defined assignment. 3 4module m1 5 implicit none 6 type :: t 7 contains 8 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t5' as their interfaces are not distinguishable 9 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t6' as their interfaces are not distinguishable 10 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t5' and 't%assign_t6' as their interfaces are not distinguishable 11 !ERROR: Defined assignment procedure 'binding' must be a subroutine 12 generic :: assignment(=) => binding 13 procedure :: binding => assign_t1 14 procedure :: assign_t 15 procedure :: assign_t2 16 procedure :: assign_t3 17 !ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments 18 !WARNING: In defined assignment subroutine 'assign_t3', second dummy argument 'y' should have INTENT(IN) or VALUE attribute 19 !WARNING: In defined assignment subroutine 'assign_t4', first dummy argument 'x' should have INTENT(OUT) or INTENT(INOUT) 20 !ERROR: In defined assignment subroutine 'assign_t5', first dummy argument 'x' may not have INTENT(IN) 21 !ERROR: In defined assignment subroutine 'assign_t6', second dummy argument 'y' may not have INTENT(OUT) 22 generic :: assignment(=) => assign_t, assign_t2, assign_t3, assign_t4, assign_t5, assign_t6 23 procedure :: assign_t4 24 procedure :: assign_t5 25 procedure :: assign_t6 26 end type 27 type :: t2 28 contains 29 procedure, nopass :: assign_t 30 !ERROR: Defined assignment procedure 'assign_t' may not have NOPASS attribute 31 generic :: assignment(=) => assign_t 32 end type 33contains 34 subroutine assign_t(x, y) 35 class(t), intent(out) :: x 36 type(t), intent(in) :: y 37 end 38 logical function assign_t1(x, y) 39 class(t), intent(out) :: x 40 type(t), intent(in) :: y 41 end 42 subroutine assign_t2(x) 43 class(t), intent(out) :: x 44 end 45 subroutine assign_t3(x, y) 46 class(t), intent(out) :: x 47 real :: y 48 end 49 subroutine assign_t4(x, y) 50 class(t) :: x 51 integer, intent(in) :: y 52 end 53 subroutine assign_t5(x, y) 54 class(t), intent(in) :: x 55 integer, intent(in) :: y 56 end 57 subroutine assign_t6(x, y) 58 class(t), intent(out) :: x 59 integer, intent(out) :: y 60 end 61end 62 63module m2 64 type :: t 65 end type 66 !ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable 67 interface assignment(=) 68 !ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL 69 subroutine s1(x, y) 70 import t 71 type(t), intent(out) :: x 72 real, optional, intent(in) :: y 73 end 74 !ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object 75 subroutine s2(x, y) 76 import t 77 type(t), intent(out) :: x 78 intent(in) :: y 79 interface 80 subroutine y() 81 end 82 end interface 83 end 84 !ERROR: In defined assignment subroutine 's3', second dummy argument 'y' must not be a pointer 85 subroutine s3(x, y) 86 import t 87 type(t), intent(out) :: x 88 type(t), intent(in), pointer :: y 89 end 90 !ERROR: In defined assignment subroutine 's4', second dummy argument 'y' must not be an allocatable 91 subroutine s4(x, y) 92 import t 93 type(t), intent(out) :: x 94 type(t), intent(in), allocatable :: y 95 end 96 end interface 97end 98 99! Detect defined assignment that conflicts with intrinsic assignment 100module m5 101 type :: t 102 end type 103 interface assignment(=) 104 ! OK - lhs is derived type 105 subroutine assign_tt(x, y) 106 import t 107 type(t), intent(out) :: x 108 type(t), intent(in) :: y 109 end 110 !OK - incompatible types 111 subroutine assign_il(x, y) 112 integer, intent(out) :: x 113 logical, intent(in) :: y 114 end 115 !OK - different ranks 116 subroutine assign_23(x, y) 117 integer, intent(out) :: x(:,:) 118 integer, intent(in) :: y(:,:,:) 119 end 120 !OK - scalar = array 121 subroutine assign_01(x, y) 122 integer, intent(out) :: x 123 integer, intent(in) :: y(:) 124 end 125 !ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment 126 subroutine assign_10(x, y) 127 integer, intent(out) :: x(:) 128 integer, intent(in) :: y 129 end 130 !ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment 131 subroutine assign_ir(x, y) 132 integer, intent(out) :: x 133 real, intent(in) :: y 134 end 135 !ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment 136 subroutine assign_ii(x, y) 137 integer(2), intent(out) :: x 138 integer(1), intent(in) :: y 139 end 140 end interface 141end 142