1! RUN: %S/test_errors.sh %s %t %flang_fc1 2! REQUIRES: shell 3! Confirm enforcement of constraints and restrictions in 7.5.7.3 4! and C733, C734 and C779, C780, C782, C783, C784, and C785. 5 6module m 7 !ERROR: An ABSTRACT derived type must be extensible 8 type, abstract, bind(c) :: badAbstract1 9 end type 10 !ERROR: An ABSTRACT derived type must be extensible 11 type, abstract :: badAbstract2 12 sequence 13 real :: badAbstract2Field 14 end type 15 type, abstract :: abstract 16 contains 17 !ERROR: DEFERRED is required when an interface-name is provided 18 procedure(s1), pass :: ab1 19 !ERROR: Type-bound procedure 'ab3' may not be both DEFERRED and NON_OVERRIDABLE 20 procedure(s1), deferred, non_overridable :: ab3 21 !ERROR: DEFERRED is only allowed when an interface-name is provided 22 procedure, deferred, non_overridable :: ab4 => s1 23 end type 24 type :: nonoverride 25 contains 26 procedure, non_overridable, nopass :: no1 => s1 27 end type 28 type, extends(nonoverride) :: nonoverride2 29 end type 30 type, extends(nonoverride2) :: nonoverride3 31 contains 32 !ERROR: Override of NON_OVERRIDABLE 'no1' is not permitted 33 procedure, nopass :: no1 => s1 34 end type 35 type, abstract :: missing 36 contains 37 procedure(s4), deferred :: am1 38 end type 39 !ERROR: Non-ABSTRACT extension of ABSTRACT derived type 'missing' lacks a binding for DEFERRED procedure 'am1' 40 type, extends(missing) :: concrete 41 end type 42 type, extends(missing) :: intermediate 43 contains 44 procedure :: am1 => s7 45 end type 46 type, extends(intermediate) :: concrete2 ! ensure no false missing binding error 47 end type 48 type, bind(c) :: inextensible1 49 end type 50 !ERROR: The parent type is not extensible 51 type, extends(inextensible1) :: badExtends1 52 end type 53 type :: inextensible2 54 sequence 55 real :: inextensible2Field 56 end type 57 !ERROR: The parent type is not extensible 58 type, extends(inextensible2) :: badExtends2 59 end type 60 !ERROR: Derived type 'real' not found 61 type, extends(real) :: badExtends3 62 end type 63 type :: base 64 real :: component 65 contains 66 !ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED 67 procedure(s2), deferred :: bb1 68 !ERROR: DEFERRED is only allowed when an interface-name is provided 69 procedure, deferred :: bb2 => s2 70 end type 71 type, extends(base) :: extension 72 contains 73 !ERROR: A type-bound procedure binding may not have the same name as a parent component 74 procedure :: component => s3 75 end type 76 type :: nopassBase 77 contains 78 procedure, nopass :: tbp => s1 79 end type 80 type, extends(nopassBase) :: passExtends 81 contains 82 !ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure 83 procedure :: tbp => s5 84 end type 85 type :: passBase 86 contains 87 procedure :: tbp => s6 88 end type 89 type, extends(passBase) :: nopassExtends 90 contains 91 !ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure 92 procedure, nopass :: tbp => s1 93 end type 94 contains 95 subroutine s1(x) 96 class(abstract), intent(in) :: x 97 end subroutine s1 98 subroutine s2(x) 99 class(base), intent(in) :: x 100 end subroutine s2 101 subroutine s3(x) 102 class(extension), intent(in) :: x 103 end subroutine s3 104 subroutine s4(x) 105 class(missing), intent(in) :: x 106 end subroutine s4 107 subroutine s5(x) 108 class(passExtends), intent(in) :: x 109 end subroutine s5 110 subroutine s6(x) 111 class(passBase), intent(in) :: x 112 end subroutine s6 113 subroutine s7(x) 114 class(intermediate), intent(in) :: x 115 end subroutine s7 116end module 117 118module m1 119 implicit none 120 interface g 121 module procedure mp 122 end interface g 123 124 type t 125 contains 126 !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface 127 procedure,pass(x) :: tbp => g 128 end type t 129 130contains 131 subroutine mp(x) 132 class(t),intent(in) :: x 133 end subroutine 134end module m1 135 136module m2 137 type parent 138 real realField 139 contains 140 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute 141 procedure proc 142 end type parent 143 type,extends(parent) :: child 144 contains 145 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute 146 procedure proc 147 end type child 148contains 149 subroutine proc 150 end subroutine 151end module m2 152 153module m3 154 type t 155 contains 156 procedure b 157 end type 158contains 159 !ERROR: Cannot use an alternate return as the passed-object dummy argument 160 subroutine b(*) 161 return 1 162 end subroutine 163end module m3 164 165module m4 166 type t 167 contains 168 procedure b 169 end type 170contains 171 ! Check to see that alternate returns work with default PASS arguments 172 subroutine b(this, *) 173 class(t) :: this 174 return 1 175 end subroutine 176end module m4 177 178module m5 179 type t 180 contains 181 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be of type 't' but is 'INTEGER(4)' 182 procedure, pass(passArg) :: b 183 end type 184contains 185 subroutine b(*, passArg) 186 integer :: passArg 187 return 1 188 end subroutine 189end module m5 190 191module m6 192 type t 193 contains 194 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be polymorphic because 't' is extensible 195 procedure, pass(passArg) :: b 196 end type 197contains 198 subroutine b(*, passArg) 199 type(t) :: passArg 200 return 1 201 end subroutine 202end module m6 203 204module m7 205 type t 206 contains 207 ! Check to see that alternate returns work with PASS arguments 208 procedure, pass(passArg) :: b 209 end type 210contains 211 subroutine b(*, passArg) 212 class(t) :: passArg 213 return 1 214 end subroutine 215end module m7 216 217program test 218 use m1 219 type,extends(t) :: t2 220 end type 221 type(t2) a 222 call a%tbp 223end program 224