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