84 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test instantiation of components that are procedure pointers.3program test4 type dtype(kindParam)5 integer, kind :: kindParam = 46 !ERROR: KIND parameter expression (kindparam) of intrinsic type REAL did not resolve to a constant value7 !ERROR: KIND parameter value (66) of intrinsic type REAL did not resolve to a supported value8 !ERROR: KIND parameter value (55) of intrinsic type REAL did not resolve to a supported value9 procedure (real(kindParam)), pointer, nopass :: field => null()10 end type11 12 type base(kindParam)13 integer, kind :: kindParam = 414 !ERROR: KIND parameter value (77) of intrinsic type REAL did not resolve to a supported value15 procedure (real(kindParam)), pointer, nopass :: field => null()16 end type17 type dependentType(kindParam)18 integer, kind :: kindParam = 419 procedure (type(base(kindParam))), pointer, nopass :: field => null()20 end type21 22 ! OK unless entities are declared with the default type23 type badDefaultType(kindParam)24 integer, kind :: kindParam = 9925 !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value26 !ERROR: KIND parameter value (44) of intrinsic type REAL did not resolve to a supported value27 procedure (real(kindParam)), pointer, nopass :: field => null()28 end type29 30 type parent(kindParam)31 integer, kind :: kindParam = 432 !ERROR: KIND parameter value (33) of intrinsic type REAL did not resolve to a supported value33 !ERROR: KIND parameter value (88) of intrinsic type REAL did not resolve to a supported value34 procedure (real(kindParam)), pointer, nopass :: parentField => null()35 end type36 type, extends(parent) :: child37 integer :: field38 end type child39contains40 subroutine testGoodDefault(arg)41 type(dtype) :: arg42 if (associated(arg%field)) stop 'fail'43 end subroutine testGoodDefault44 45 subroutine testStar(arg)46 !ERROR: Value of KIND type parameter 'kindparam' must be constant47 type(dtype(*)),intent(inout) :: arg48 if (associated(arg%field)) stop 'fail'49 end subroutine testStar50 51 subroutine testBadDeclaration(arg)52 type(dtype(66)) :: arg53 if (associated(arg%field)) stop 'fail'54 end subroutine testBadDeclaration55 56 subroutine testBadLocalDeclaration()57 type(dtype(55)) :: local58 if (associated(local%field)) stop 'fail'59 end subroutine testBadLocalDeclaration60 61 subroutine testDependent()62 type(dependentType(77)) :: local63 end subroutine testDependent64 65 subroutine testBadDefault()66 type(badDefaultType) :: local67 end subroutine testBadDefault68 69 subroutine testBadDefaultWithBadDeclaration()70 type(badDefaultType(44)) :: local71 end subroutine testBadDefaultWithBadDeclaration72 73 subroutine testBadDefaultWithGoodDeclaration()74 type(badDefaultType(4)) :: local75 end subroutine testBadDefaultWithGoodDeclaration76 77 subroutine testExtended()78 type(child(33)) :: local179 type(child(4)) :: local280 type(parent(88)) :: local381 type(parent(8)) :: local482 end subroutine testExtended83end program test84