-
Notifications
You must be signed in to change notification settings - Fork 1
/
hasty_test_caf_basic.F90
141 lines (123 loc) · 6.1 KB
/
hasty_test_caf_basic.F90
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
!< HASTY test hash table CAF basic.
program hasty_test_caf_basic
!-----------------------------------------------------------------------------------------------------------------------------------
!< HASTY test hash table CAF basic.
!-----------------------------------------------------------------------------------------------------------------------------------
use, intrinsic :: iso_fortran_env, only : int32, int64, error_unit
use hasty
use tester
!-----------------------------------------------------------------------------------------------------------------------------------
!-----------------------------------------------------------------------------------------------------------------------------------
type(tester_t) :: hasty_tester !< Tests handler.
type(hash_table) :: a_table !< A table.
class(*), pointer :: a_content !< A content.
class(*), allocatable :: a_new_content !< A content.
!-----------------------------------------------------------------------------------------------------------------------------------
!-----------------------------------------------------------------------------------------------------------------------------------
call hasty_tester%init
call a_table%initialize(buckets_number=4, use_prime=.true.)
#ifdef CAF
call a_table%add_clone(key=1_int32, content=int(this_image(), int32))
call a_table%add_clone(key=3_int32, content=int(this_image(), int32))
call a_table%add_clone(key=10_int32, content=int(this_image(), int32))
call a_table%add_clone(key=13_int32, content=int(this_image(), int32))
call a_table%add_clone(key=16_int32, content=int(this_image(), int32))
call a_table%add_clone(key=22_int32, content=int(this_image(), int32))
call a_table%add_clone(key=27_int32, content=int(this_image(), int32))
call a_table%add_clone(key=31_int32, content=int(this_image(), int32))
call a_table%add_clone(key=40_int32, content=int(this_image(), int32))
sync all
a_content => a_table%get_pointer(key=3_int32)
if (associated(a_content)) then
call test_assert_equal(content=a_content, reference=int(this_image(), int32))
call hasty_tester%print
write(error_unit, *) ' I am image: ', this_image(), ' and I HAVE key=3'
else
write(error_unit, *) ' I am image: ', this_image(), ' and I have NOT key=3'
endif
sync all
sync all
critical
call a_table%get_clone(key=3_int32, content=a_new_content)
end critical
! if (allocated(a_new_content)) then
! call test_assert_equal(content=a_content, reference=int(mod(mod(3, 5) + 1, num_images())+1, int32))
! call hasty_tester%print
! write(error_unit, *) ' I am image: ', this_image(), ' and I HAVE a copy key=3'
! else
! write(error_unit, *) ' I am image: ', this_image(), ' and I have NOT a copy key=3'
! endif
sync all
if (this_image()==1) write(error_unit, *) 'Keys/Contents'
sync all
critical
call a_table%traverse(iterator=print_content_iterator)
end critical
sync all
if (this_image()==1) write(error_unit, *) 'IDs'
sync all
critical
write(error_unit, *) ' image: ', this_image(), ' ids = ', a_table%ids()
end critical
sync all
if (this_image()==1) write(error_unit, *) 'IDs global'
sync all
critical
write(error_unit, *) ' image: ', this_image(), ' ids global = ', a_table%ids(global=.true.)
end critical
sync all
if (this_image()==1) write(error_unit, *) 'Length'
sync all
critical
write(error_unit, *) ' image: ', this_image(), ' table length ', len(a_table)
end critical
sync all
if (this_image()==1) write(error_unit, *) 'Global length', len(a_table, global=.true.)
call a_table%destroy
if (this_image()==1) write(error_unit, *) 'Length'
sync all
critical
write(error_unit, *) ' image: ', this_image(), ' table length ', len(a_table)
end critical
sync all
#endif
!-----------------------------------------------------------------------------------------------------------------------------------
contains
subroutine test_assert_equal(content, reference)
!---------------------------------------------------------------------------------------------------------------------------------
!< Test `content==reference`.
!---------------------------------------------------------------------------------------------------------------------------------
class(*), intent(in) :: content !< Content value.
integer(int32), intent(in) :: reference !< Reference value.
!---------------------------------------------------------------------------------------------------------------------------------
!---------------------------------------------------------------------------------------------------------------------------------
select type(content)
type is(integer(int32))
call hasty_tester%assert_equal(content, reference)
endselect
!---------------------------------------------------------------------------------------------------------------------------------
endsubroutine test_assert_equal
subroutine print_content_iterator(key, content, done)
!---------------------------------------------------------------------------------------------------------------------------------
!< Iterator that print contents.
!---------------------------------------------------------------------------------------------------------------------------------
class(*), intent(in) :: key !< The node key.
class(*), pointer, intent(in) :: content !< The generic content.
logical, intent(out) :: done !< Flag to set to true to stop traversing.
!---------------------------------------------------------------------------------------------------------------------------------
!---------------------------------------------------------------------------------------------------------------------------------
if (associated(content)) then
select type(content)
type is(integer(int32))
select type(key)
type is(key_base)
#ifdef CAF
write(error_unit, *) ' image: ', this_image(), 'key: ', key%stringify(), ' content: ', content
#endif
endselect
endselect
endif
done = .false.
!---------------------------------------------------------------------------------------------------------------------------------
endsubroutine print_content_iterator
endprogram hasty_test_caf_basic