1! RUN: %S/test_errors.sh %s %t %flang_fc1 2! REQUIRES: shell 3! Test instantiation of components that are procedure pointers. 4! 5program test 6 type dtype(kindParam) 7 integer, kind :: kindParam = 4 8 !ERROR: KIND parameter value (66) of intrinsic type REAL did not resolve to a supported value 9 !ERROR: KIND parameter value (55) of intrinsic type REAL did not resolve to a supported value 10 procedure (real(kindParam)), pointer, nopass :: field => null() 11 end type 12 13 type base(kindParam) 14 integer, kind :: kindParam = 4 15 !ERROR: KIND parameter value (77) of intrinsic type REAL did not resolve to a supported value 16 procedure (real(kindParam)), pointer, nopass :: field => null() 17 end type 18 type dependentType(kindParam) 19 integer, kind :: kindParam = 4 20 procedure (type(base(kindParam))), pointer, nopass :: field => null() 21 end type 22 23 ! OK unless entities are declared with the default type 24 type badDefaultType(kindParam) 25 integer, kind :: kindParam = 99 26 !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value 27 !ERROR: KIND parameter value (44) of intrinsic type REAL did not resolve to a supported value 28 procedure (real(kindParam)), pointer, nopass :: field => null() 29 end type 30 31 type parent(kindParam) 32 integer, kind :: kindParam = 4 33 !ERROR: KIND parameter value (33) of intrinsic type REAL did not resolve to a supported value 34 !ERROR: KIND parameter value (88) of intrinsic type REAL did not resolve to a supported value 35 procedure (real(kindParam)), pointer, nopass :: parentField => null() 36 end type 37 type, extends(parent) :: child 38 integer :: field 39 end type child 40contains 41 subroutine testGoodDefault(arg) 42 type(dtype) :: arg 43 if (associated(arg%field)) stop 'fail' 44 end subroutine testGoodDefault 45 46 subroutine testStar(arg) 47 type(dtype(*)),intent(inout) :: arg 48 if (associated(arg%field)) stop 'fail' 49 end subroutine testStar 50 51 subroutine testBadDeclaration(arg) 52 type(dtype(66)) :: arg 53 if (associated(arg%field)) stop 'fail' 54 end subroutine testBadDeclaration 55 56 subroutine testBadLocalDeclaration() 57 type(dtype(55)) :: local 58 if (associated(local%field)) stop 'fail' 59 end subroutine testBadLocalDeclaration 60 61 subroutine testDependent() 62 type(dependentType(77)) :: local 63 end subroutine testDependent 64 65 subroutine testBadDefault() 66 type(badDefaultType) :: local 67 end subroutine testBadDefault 68 69 subroutine testBadDefaultWithBadDeclaration() 70 type(badDefaultType(44)) :: local 71 end subroutine testBadDefaultWithBadDeclaration 72 73 subroutine testBadDefaultWithGoodDeclaration() 74 type(badDefaultType(4)) :: local 75 end subroutine testBadDefaultWithGoodDeclaration 76 77 subroutine testExtended() 78 type(child(33)) :: local1 79 type(child(4)) :: local2 80 type(parent(88)) :: local3 81 type(parent(8)) :: local4 82 end subroutine testExtended 83end program test 84