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