142 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Test restrictions on what subprograms can be used for defined assignment.3 4module m15 implicit none6 type :: t7 contains8 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t5' as their interfaces are not distinguishable9 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t6' as their interfaces are not distinguishable10 !ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t5' and 't%assign_t6' as their interfaces are not distinguishable11 !ERROR: Defined assignment procedure 'binding' must be a subroutine12 generic :: assignment(=) => binding13 procedure :: binding => assign_t114 procedure :: assign_t15 procedure :: assign_t216 procedure :: assign_t317 !ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments18 !WARNING: In defined assignment subroutine 'assign_t3', second dummy argument 'y' should have INTENT(IN) or VALUE attribute [-Wdefined-operator-args]19 !WARNING: In defined assignment subroutine 'assign_t4', first dummy argument 'x' should have INTENT(OUT) or INTENT(INOUT) [-Wdefined-operator-args]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_t623 procedure :: assign_t424 procedure :: assign_t525 procedure :: assign_t626 end type27 type :: t228 contains29 procedure, nopass :: assign_t30 !ERROR: Defined assignment procedure 'assign_t' may not have NOPASS attribute31 generic :: assignment(=) => assign_t32 end type33contains34 subroutine assign_t(x, y)35 class(t), intent(out) :: x36 type(t), intent(in) :: y37 end38 logical function assign_t1(x, y)39 class(t), intent(out) :: x40 type(t), intent(in) :: y41 end42 subroutine assign_t2(x)43 class(t), intent(out) :: x44 end45 subroutine assign_t3(x, y)46 class(t), intent(out) :: x47 real :: y48 end49 subroutine assign_t4(x, y)50 class(t) :: x51 integer, intent(in) :: y52 end53 subroutine assign_t5(x, y)54 class(t), intent(in) :: x55 integer, intent(in) :: y56 end57 subroutine assign_t6(x, y)58 class(t), intent(out) :: x59 integer, intent(out) :: y60 end61end62 63module m264 type :: t65 end type66 !ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable67 interface assignment(=)68 !ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL69 subroutine s1(x, y)70 import t71 type(t), intent(out) :: x72 real, optional, intent(in) :: y73 end74 !ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object75 subroutine s2(x, y)76 import t77 type(t), intent(out) :: x78 intent(in) :: y79 interface80 subroutine y()81 end82 end interface83 end84 !ERROR: In defined assignment subroutine 's3', second dummy argument 'y' must not be a pointer85 subroutine s3(x, y)86 import t87 type(t), intent(out) :: x88 type(t), intent(in), pointer :: y89 end90 !ERROR: In defined assignment subroutine 's4', second dummy argument 'y' must not be an allocatable91 subroutine s4(x, y)92 import t93 type(t), intent(out) :: x94 type(t), intent(in), allocatable :: y95 end96 end interface97end98 99! Detect defined assignment that conflicts with intrinsic assignment100module m5101 type :: t102 end type103 interface assignment(=)104 ! OK - lhs is derived type105 subroutine assign_tt(x, y)106 import t107 type(t), intent(out) :: x108 type(t), intent(in) :: y109 end110 !OK - incompatible types111 subroutine assign_il(x, y)112 integer, intent(out) :: x113 logical, intent(in) :: y114 end115 !OK - different ranks116 subroutine assign_23(x, y)117 integer, intent(out) :: x(:,:)118 integer, intent(in) :: y(:,:,:)119 end120 !OK - scalar = array121 subroutine assign_01(x, y)122 integer, intent(out) :: x123 integer, intent(in) :: y(:)124 end125 !ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment126 subroutine assign_10(x, y)127 integer, intent(out) :: x(:)128 integer, intent(in) :: y129 end130 !ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment131 subroutine assign_ir(x, y)132 integer, intent(out) :: x133 real, intent(in) :: y134 end135 !ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment136 subroutine assign_ii(x, y)137 integer(2), intent(out) :: x138 integer(1), intent(in) :: y139 end140 end interface141end142