345 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Confirm enforcement of constraints and restrictions in 7.5.7.33! and C733, C734 and C779, C780, C782, C783, C784, and C785.4 5module m6 !ERROR: An ABSTRACT derived type must be extensible7 !PORTABILITY: A derived type with the BIND attribute should not be empty [-Wempty-bind-c-derived-type]8 type, abstract, bind(c) :: badAbstract19 end type10 !ERROR: An ABSTRACT derived type must be extensible11 type, abstract :: badAbstract212 sequence13 real :: badAbstract2Field14 end type15 type, abstract :: abstract16 contains17 !ERROR: DEFERRED is required when an interface-name is provided18 procedure(s1), pass :: ab119 !ERROR: Type-bound procedure 'ab3' may not be both DEFERRED and NON_OVERRIDABLE20 procedure(s1), deferred, non_overridable :: ab321 !ERROR: DEFERRED is only allowed when an interface-name is provided22 procedure, deferred, non_overridable :: ab4 => s123 end type24 type :: nonoverride25 contains26 procedure, non_overridable, nopass :: no1 => s127 end type28 type, extends(nonoverride) :: nonoverride229 end type30 type, extends(nonoverride2) :: nonoverride331 contains32 !ERROR: Override of NON_OVERRIDABLE 'no1' is not permitted33 procedure, nopass :: no1 => s134 end type35 type, abstract :: missing36 contains37 procedure(s4), deferred :: am138 end type39 !ERROR: Non-ABSTRACT extension of ABSTRACT derived type 'missing' lacks a binding for DEFERRED procedure 'am1'40 type, extends(missing) :: concrete41 end type42 type, extends(missing) :: intermediate43 contains44 procedure :: am1 => s745 end type46 type, extends(intermediate) :: concrete2 ! ensure no false missing binding error47 end type48 !WARNING: A derived type with the BIND attribute should not be empty [-Wempty-bind-c-derived-type]49 type, bind(c) :: inextensible150 end type51 !ERROR: The parent type is not extensible52 type, extends(inextensible1) :: badExtends153 end type54 type :: inextensible255 sequence56 real :: inextensible2Field57 end type58 !ERROR: The parent type is not extensible59 type, extends(inextensible2) :: badExtends260 end type61 !ERROR: Derived type 'real' not found62 type, extends(real) :: badExtends363 end type64 type :: base65 real :: component66 contains67 !ERROR: Procedure bound to non-ABSTRACT derived type 'base' may not be DEFERRED68 procedure(s2), deferred :: bb169 !ERROR: DEFERRED is only allowed when an interface-name is provided70 procedure, deferred :: bb2 => s271 end type72 type, extends(base) :: extension73 contains74 !ERROR: A type-bound procedure binding may not have the same name as a parent component75 procedure :: component => s376 end type77 type :: nopassBase78 contains79 procedure, nopass :: tbp => s180 end type81 type, extends(nopassBase) :: passExtends82 contains83 !ERROR: A passed-argument type-bound procedure may not override a NOPASS procedure84 procedure :: tbp => s585 end type86 type :: passBase87 contains88 procedure :: tbp => s689 end type90 type, extends(passBase) :: nopassExtends91 contains92 !ERROR: A NOPASS type-bound procedure may not override a passed-argument procedure93 procedure, nopass :: tbp => s194 end type95 contains96 subroutine s1(x)97 class(abstract), intent(in) :: x98 end subroutine s199 subroutine s2(x)100 class(base), intent(in) :: x101 end subroutine s2102 subroutine s3(x)103 class(extension), intent(in) :: x104 end subroutine s3105 subroutine s4(x)106 class(missing), intent(in) :: x107 end subroutine s4108 subroutine s5(x)109 class(passExtends), intent(in) :: x110 end subroutine s5111 subroutine s6(x)112 class(passBase), intent(in) :: x113 end subroutine s6114 subroutine s7(x)115 class(intermediate), intent(in) :: x116 end subroutine s7117end module118 119module m1120 implicit none121 interface g122 module procedure mp123 end interface g124 125 type t126 contains127 !ERROR: The binding of 'tbp' ('g') must be either an accessible module procedure or an external procedure with an explicit interface128 procedure,pass(x) :: tbp => g129 end type t130 131contains132 subroutine mp(x)133 class(t),intent(in) :: x134 end subroutine135end module m1136 137module m2138 type parent139 real realField140 contains141 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute142 procedure proc143 end type parent144 type,extends(parent) :: child145 contains146 !ERROR: Procedure binding 'proc' with no dummy arguments must have NOPASS attribute147 procedure proc148 end type child149contains150 subroutine proc 151 end subroutine152end module m2153 154module m3155 type t156 contains157 procedure b158 end type159contains160 !ERROR: Cannot use an alternate return as the passed-object dummy argument161 subroutine b(*)162 return 1163 end subroutine164end module m3165 166module m4167 type t168 contains169 procedure b170 end type171contains172 ! Check to see that alternate returns work with default PASS arguments173 subroutine b(this, *)174 class(t) :: this175 return 1176 end subroutine177end module m4178 179module m5180 type t181 contains182 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be of type 't' but is 'INTEGER(4)'183 procedure, pass(passArg) :: b184 end type185contains186 subroutine b(*, passArg)187 integer :: passArg188 return 1189 end subroutine190end module m5191 192module m6193 type t194 contains195 !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be polymorphic because 't' is extensible196 procedure, pass(passArg) :: b197 end type198contains199 subroutine b(*, passArg)200 type(t) :: passArg201 return 1202 end subroutine203end module m6204 205module m7206 type t207 contains208 ! Check to see that alternate returns work with PASS arguments209 procedure, pass(passArg) :: b210 end type211contains212 subroutine b(*, passArg)213 class(t) :: passArg214 return 1215 end subroutine216end module m7217 218module m8 ! C1529 - warning only219 type t220 procedure(mysubr), pointer, nopass :: pp221 contains222 procedure, nopass :: tbp => mysubr223 end type224 contains225 subroutine mysubr226 end subroutine227 subroutine test228 type(t) a(2)229 !PORTABILITY: Base of NOPASS type-bound procedure reference should be scalar [-Wnopass-scalar-base]230 call a%tbp231 !ERROR: Base of procedure component reference must be scalar232 call a%pp233 end subroutine234end module235 236module m9237 type t1238 contains239 procedure, public :: tbp => sub1240 end type241 type, extends(t1) :: t2242 contains243 !ERROR: A PRIVATE procedure may not override a PUBLIC procedure244 procedure, private :: tbp => sub2245 end type246 contains247 subroutine sub1(x)248 class(t1), intent(in) :: x249 end subroutine250 subroutine sub2(x)251 class(t2), intent(in) :: x252 end subroutine253end module254 255module m10a256 type t1257 contains258 procedure :: tbp => sub1259 end type260 contains261 subroutine sub1(x)262 class(t1), intent(in) :: x263 end subroutine264end module265module m10b266 use m10a267 type, extends(t1) :: t2268 contains269 !ERROR: A PRIVATE procedure may not override an accessible procedure270 procedure, private :: tbp => sub2271 end type272 contains273 subroutine sub2(x)274 class(t2), intent(in) :: x275 end subroutine276end module277 278module m11279 type t1280 contains281 procedure, nopass :: tbp => t1p282 end type283 type, extends(t1) :: t2284 contains285 private286 !ERROR: A PRIVATE procedure may not override a PUBLIC procedure287 procedure, nopass :: tbp => t2p288 end type289 contains290 subroutine t1p291 end292 subroutine t2p293 end294end295 296module m12297 type t298 procedure(sub), pointer, nopass :: pp299 contains300 procedure, non_overridable, nopass :: tbp1 => sub301 procedure, nopass :: tbp2 => sub302 generic :: gen1 => tbp1303 generic :: gen2 => tbp2304 end type305 contains306 subroutine sub307 end308 subroutine test(x, y)309 class(t) :: x[*]310 type(t) :: y[*]311 call x%pp ! ok312 call y%pp ! ok313 !ERROR: Base of procedure component reference may not be coindexed314 call x[1]%pp315 !ERROR: Base of procedure component reference may not be coindexed316 call y[1]%pp317 call x%tbp1 ! ok318 call y%tbp1 ! ok319 call x[1]%tbp1 ! ok320 call y[1]%tbp1 ! ok321 call x%tbp2 ! ok322 call y%tbp2 ! ok323 !ERROR: A procedure binding may not be coindexed unless it can be resolved at compilation time324 call x[1]%tbp2325 call y[1]%tbp2 ! ok326 call x%gen1 ! ok327 call y%gen1 ! ok328 call x[1]%gen1 ! ok329 call y[1]%gen1 ! ok330 call x%gen2 ! ok331 call y%gen2 ! ok332 !ERROR: A procedure binding may not be coindexed unless it can be resolved at compilation time333 call x[1]%gen2334 call y[1]%gen2 ! ok335 end336end337 338program test339 use m1340 type,extends(t) :: t2341 end type342 type(t2) a343 call a%tbp344end program345