1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Confirm enforcement of constraints and restrictions in 7.5.7.3 3! and C733, C734 and C779, C780, C782, C783, C784, and C785. 4 5module m 6 !ERROR: An ABSTRACT derived type must be extensible 7 !PORTABILITY: A derived type with the BIND attribute should not be empty 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 !WARNING: A derived type with the BIND attribute should not be empty 49 type, bind(c) :: inextensible1 50 end type 51 !ERROR: The parent type is not extensible 52 type, extends(inextensible1) :: badExtends1 53 end type 54 type :: inextensible2 55 sequence 56 real :: inextensible2Field 57 end type 58 !ERROR: The parent type is not extensible 59 type, extends(inextensible2) :: badExtends2 60 end type 61 !ERROR: Derived type 'real' not found 62 type, extends(real) :: badExtends3 63 end type 64 type :: base 65 real :: component 66 contains 67 !ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED 68 procedure(s2), deferred :: bb1 69 !ERROR: DEFERRED is only allowed when an interface-name is provided 70 procedure, deferred :: bb2 => s2 71 end type 72 type, extends(base) :: extension 73 contains 74 !ERROR: A type-bound procedure binding may not have the same name as a parent component 75 procedure :: component => s3 76 end type 77 type :: nopassBase 78 contains 79 procedure, nopass :: tbp => s1 80 end type 81 type, extends(nopassBase) :: passExtends 82 contains 83 !ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure 84 procedure :: tbp => s5 85 end type 86 type :: passBase 87 contains 88 procedure :: tbp => s6 89 end type 90 type, extends(passBase) :: nopassExtends 91 contains 92 !ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure 93 procedure, nopass :: tbp => s1 94 end type 95 contains 96 subroutine s1(x) 97 class(abstract), intent(in) :: x 98 end subroutine s1 99 subroutine s2(x) 100 class(base), intent(in) :: x 101 end subroutine s2 102 subroutine s3(x) 103 class(extension), intent(in) :: x 104 end subroutine s3 105 subroutine s4(x) 106 class(missing), intent(in) :: x 107 end subroutine s4 108 subroutine s5(x) 109 class(passExtends), intent(in) :: x 110 end subroutine s5 111 subroutine s6(x) 112 class(passBase), intent(in) :: x 113 end subroutine s6 114 subroutine s7(x) 115 class(intermediate), intent(in) :: x 116 end subroutine s7 117end module 118 119module m1 120 implicit none 121 interface g 122 module procedure mp 123 end interface g 124 125 type t 126 contains 127 !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface 128 procedure,pass(x) :: tbp => g 129 end type t 130 131contains 132 subroutine mp(x) 133 class(t),intent(in) :: x 134 end subroutine 135end module m1 136 137module m2 138 type parent 139 real realField 140 contains 141 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute 142 procedure proc 143 end type parent 144 type,extends(parent) :: child 145 contains 146 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute 147 procedure proc 148 end type child 149contains 150 subroutine proc 151 end subroutine 152end module m2 153 154module m3 155 type t 156 contains 157 procedure b 158 end type 159contains 160 !ERROR: Cannot use an alternate return as the passed-object dummy argument 161 subroutine b(*) 162 return 1 163 end subroutine 164end module m3 165 166module m4 167 type t 168 contains 169 procedure b 170 end type 171contains 172 ! Check to see that alternate returns work with default PASS arguments 173 subroutine b(this, *) 174 class(t) :: this 175 return 1 176 end subroutine 177end module m4 178 179module m5 180 type t 181 contains 182 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be of type 't' but is 'INTEGER(4)' 183 procedure, pass(passArg) :: b 184 end type 185contains 186 subroutine b(*, passArg) 187 integer :: passArg 188 return 1 189 end subroutine 190end module m5 191 192module m6 193 type t 194 contains 195 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be polymorphic because 't' is extensible 196 procedure, pass(passArg) :: b 197 end type 198contains 199 subroutine b(*, passArg) 200 type(t) :: passArg 201 return 1 202 end subroutine 203end module m6 204 205module m7 206 type t 207 contains 208 ! Check to see that alternate returns work with PASS arguments 209 procedure, pass(passArg) :: b 210 end type 211contains 212 subroutine b(*, passArg) 213 class(t) :: passArg 214 return 1 215 end subroutine 216end module m7 217 218module m8 ! C1529 - warning only 219 type t 220 procedure(mysubr), pointer, nopass :: pp 221 contains 222 procedure, nopass :: tbp => mysubr 223 end type 224 contains 225 subroutine mysubr 226 end subroutine 227 subroutine test 228 type(t) a(2) 229 !PORTABILITY: Base of NOPASS type-bound procedure reference should be scalar 230 call a%tbp 231 !ERROR: Base of procedure component reference must be scalar 232 call a%pp 233 end subroutine 234end module 235 236module m9 237 type t1 238 contains 239 procedure, public :: tbp => sub1 240 end type 241 type, extends(t1) :: t2 242 contains 243 !ERROR: A PRIVATE procedure may not override a PUBLIC procedure 244 procedure, private :: tbp => sub2 245 end type 246 contains 247 subroutine sub1(x) 248 class(t1), intent(in) :: x 249 end subroutine 250 subroutine sub2(x) 251 class(t2), intent(in) :: x 252 end subroutine 253end module 254 255module m10a 256 type t1 257 contains 258 procedure :: tbp => sub1 259 end type 260 contains 261 subroutine sub1(x) 262 class(t1), intent(in) :: x 263 end subroutine 264end module 265module m10b 266 use m10a 267 type, extends(t1) :: t2 268 contains 269 !ERROR: A PRIVATE procedure may not override an accessible procedure 270 procedure, private :: tbp => sub2 271 end type 272 contains 273 subroutine sub2(x) 274 class(t2), intent(in) :: x 275 end subroutine 276end module 277 278module m11 279 type t1 280 contains 281 procedure, nopass :: tbp => t1p 282 end type 283 type, extends(t1) :: t2 284 contains 285 private 286 !ERROR: A PRIVATE procedure may not override a PUBLIC procedure 287 procedure, nopass :: tbp => t2p 288 end type 289 contains 290 subroutine t1p 291 end 292 subroutine t2p 293 end 294end 295 296program test 297 use m1 298 type,extends(t) :: t2 299 end type 300 type(t2) a 301 call a%tbp 302end program 303