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
|
module class_18_mod
use iso_fortran_env
implicit none
type KeywordEnforcer
end type KeywordEnforcer
public :: Integer32Complex32Map
public :: Integer32Complex32Pair
type :: Integer32Complex32Pair
integer(kind=INT32) :: first
complex(kind=REAL32) :: second
end type Integer32Complex32Pair
type, abstract :: map_s_BaseNode
end type map_s_BaseNode
type, extends(map_s_BaseNode) :: map_s_Node
type(map_s_Node), pointer :: parent => null()
end type map_s_Node
type :: map_Set
private
class(map_s_BaseNode), allocatable :: root
contains
procedure :: insert_single => map_s_insert_single
generic :: insert => insert_single
end type map_Set
type :: Integer32Complex32Map
private
type(map_Set) :: tree
contains
procedure :: of => map_of
end type Integer32Complex32Map
contains
subroutine map_s_insert_single(this, value, unused, is_new)
class(map_Set), target, intent(inout) :: this
type(Integer32Complex32Pair), intent(in) :: value
integer, optional :: unused
logical, optional, intent(out) :: is_new
if (present(is_new)) then
is_new = .true.
end if
if (present(unused)) then
unused = 21
end if
end subroutine map_s_insert_single
subroutine map_of(this, key)
class(Integer32Complex32Map), target, intent(inout) :: this
integer(kind=INT32), intent(in) :: key
type(Integer32Complex32Pair) :: p
logical :: is_new1, is_new2, is_new3
integer :: unused1, unused2, unused3
p%first= key
call this%tree%insert(p, is_new=is_new1)
if (is_new1 .eqv. .false.) error stop
call this%tree%insert(p, unused=unused1)
if (unused1 /= 21) error stop
call this%tree%insert(p, is_new=is_new2, unused=unused2)
if (is_new2 .eqv. .false.) error stop
if (unused2 /= 21) error stop
call this%tree%insert(p, unused=unused3, is_new=is_new3)
if (is_new3 .eqv. .false.) error stop
if (unused3 /= 21) error stop
end subroutine map_of
end module class_18_mod
program class_18
use class_18_mod
implicit none
type(Integer32Complex32Map) :: m
call m%of(42)
end program
|
