xref: /llvm-project/flang/test/Semantics/resolve105.f90 (revision c9da9c0d74ec5f5cf92be73783a00f7139dfc070) 
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Test instantiation of components that are procedure pointers.
3!
4program test
5  type dtype(kindParam)
6    integer, kind :: kindParam = 4
7    !ERROR: KIND parameter value (66) of intrinsic type REAL did not resolve to a supported value
8    !ERROR: KIND parameter value (55) of intrinsic type REAL did not resolve to a supported value
9    procedure (real(kindParam)), pointer, nopass :: field => null()
10  end type
11
12  type base(kindParam)
13    integer, kind :: kindParam = 4
14    !ERROR: KIND parameter value (77) of intrinsic type REAL did not resolve to a supported value
15    procedure (real(kindParam)), pointer, nopass :: field => null()
16  end type
17  type dependentType(kindParam)
18    integer, kind :: kindParam = 4
19    procedure (type(base(kindParam))), pointer, nopass :: field => null()
20  end type
21
22  ! OK unless entities are declared with the default type
23  type badDefaultType(kindParam)
24    integer, kind :: kindParam = 99
25    !ERROR: KIND parameter value (99) of intrinsic type REAL did not resolve to a supported value
26    !ERROR: KIND parameter value (44) of intrinsic type REAL did not resolve to a supported value
27    procedure (real(kindParam)), pointer, nopass :: field => null()
28  end type
29
30  type parent(kindParam)
31    integer, kind :: kindParam = 4
32    !ERROR: KIND parameter value (33) of intrinsic type REAL did not resolve to a supported value
33    !ERROR: KIND parameter value (88) of intrinsic type REAL did not resolve to a supported value
34    procedure (real(kindParam)), pointer, nopass :: parentField => null()
35  end type
36  type, extends(parent) :: child
37    integer :: field
38  end type child
39contains
40  subroutine testGoodDefault(arg)
41    type(dtype) :: arg
42    if (associated(arg%field)) stop 'fail'
43  end subroutine testGoodDefault
44
45  subroutine testStar(arg)
46    !ERROR: Value of KIND type parameter 'kindparam' must be constant
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