@@ -24,7 +24,8 @@ module test_stdlib_chaining_maps
24
24
integer, parameter :: test_size = rand_size*4
25
25
integer, parameter :: test_16 = 2**4
26
26
integer, parameter :: test_256 = 2**8
27
-
27
+ integer, parameter :: key_types = 3
28
+ character(len=*), parameter :: char_type = ' '
28
29
public :: collect_stdlib_chaining_maps
29
30
30
31
contains
@@ -53,10 +54,10 @@ contains
53
54
type(error_type), allocatable, intent(out) :: error
54
55
55
56
type(chaining_hashmap_type) :: map
56
- integer(int8) :: test_8_bits(test_size)
57
+ integer(int8) :: test_8_bits(test_size,key_types )
57
58
58
59
call generate_vector(test_8_bits)
59
-
60
+
60
61
call map % init( ${hash_}$, slots_bits=10 )
61
62
62
63
call test_input_random_data(error, map, test_8_bits, test_${size_}$)
@@ -77,29 +78,32 @@ contains
77
78
78
79
79
80
subroutine generate_vector(test_8_bits)
80
- integer(int8), intent(out) :: test_8_bits(test_size)
81
+ integer(int8), intent(out) :: test_8_bits(test_size, key_types )
81
82
82
- integer :: index
83
+ integer :: index, key_type
83
84
real(dp) :: rand2(2)
84
85
integer(int32) :: rand_object(rand_size)
85
-
86
- do index=1, rand_size
87
- call random_number(rand2)
88
- if (rand2(1) < 0.5_dp) then
89
- rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
90
- else
91
- rand_object(index) = floor(rand2(2)*hugep1, int32)
92
- end if
86
+ integer :: key_type
87
+
88
+ do key_type = 1, key_types
89
+ do index=1, rand_size
90
+ call random_number(rand2)
91
+ if (rand2(1) < 0.5_dp) then
92
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
93
+ else
94
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
95
+ end if
96
+ end do
97
+
98
+ test_8_bits(:,key_type) = transfer( rand_object, 0_int8, test_size )
93
99
end do
94
100
95
- test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
96
-
97
101
end subroutine
98
102
99
103
subroutine test_input_random_data(error, map, test_8_bits, test_block)
100
104
type(error_type), allocatable, intent(out) :: error
101
105
type(chaining_hashmap_type), intent(inout) :: map
102
- integer(int8), intent(in) :: test_8_bits(test_size)
106
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
103
107
integer(int_index), intent(in) :: test_block
104
108
class(*), allocatable :: dummy
105
109
type(dummy_type) :: dummy_val
@@ -108,32 +112,54 @@ contains
108
112
type(other_type) :: other
109
113
logical :: conflict
110
114
111
- do index2=1, size(test_8_bits) , test_block
112
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
115
+ do index2=1, test_size , test_block
116
+
113
117
if (allocated(dummy)) deallocate(dummy)
114
- dummy_val % value = test_8_bits( index2:index2+test_block-1 )
118
+ dummy_val % value = test_8_bits( index2:index2+test_block-1, 1 )
115
119
allocate( dummy, source=dummy_val )
116
120
call set ( other, dummy )
121
+
122
+ ! Test all key interfaces
123
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
124
+ call map % map_entry( key, other, conflict )
125
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
126
+
127
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
117
128
call map % map_entry( key, other, conflict )
118
129
call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
130
+
131
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
132
+ call map % map_entry( key, other, conflict )
133
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
134
+
119
135
if (allocated(error)) return
136
+
120
137
end do
121
138
122
139
end subroutine
123
140
124
141
subroutine test_inquire_data(error, map, test_8_bits, test_block)
125
142
type(error_type), allocatable, intent(out) :: error
126
143
type(chaining_hashmap_type), intent(inout) :: map
127
- integer(int8), intent(in) :: test_8_bits(test_size)
144
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
128
145
integer(int_index), intent(in) :: test_block
129
146
integer :: index2
130
147
logical :: present
131
148
type(key_type) :: key
132
149
133
- do index2=1, size(test_8_bits), test_block
134
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
150
+ do index2=1, test_size, test_block
151
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
152
+ call map % key_test( key, present )
153
+ call check(error, present, "KEY not found in map KEY_TEST.")
154
+
155
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
156
+ call map % key_test( key, present )
157
+ call check(error, present, "KEY not found in map KEY_TEST.")
158
+
159
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
135
160
call map % key_test( key, present )
136
161
call check(error, present, "KEY not found in map KEY_TEST.")
162
+
137
163
if (allocated(error)) return
138
164
end do
139
165
@@ -142,15 +168,23 @@ contains
142
168
subroutine test_get_data(error, map, test_8_bits, test_block)
143
169
type(error_type), allocatable, intent(out) :: error
144
170
type(chaining_hashmap_type), intent(inout) :: map
145
- integer(int8), intent(in) :: test_8_bits(test_size)
171
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
146
172
integer(int_index), intent(in) :: test_block
147
173
integer :: index2
148
174
type(key_type) :: key
149
175
type(other_type) :: other
150
176
logical :: exists
151
177
152
- do index2=1, size(test_8_bits), test_block
153
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
178
+ do index2=1, test_size, test_block
179
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
180
+ call map % get_other_data( key, other, exists )
181
+ call check(error, exists, "Unable to get data because key not found in map.")
182
+
183
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
184
+ call map % get_other_data( key, other, exists )
185
+ call check(error, exists, "Unable to get data because key not found in map.")
186
+
187
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
154
188
call map % get_other_data( key, other, exists )
155
189
call check(error, exists, "Unable to get data because key not found in map.")
156
190
end do
@@ -160,14 +194,22 @@ contains
160
194
subroutine test_removal(error, map, test_8_bits, test_block)
161
195
type(error_type), allocatable, intent(out) :: error
162
196
type(chaining_hashmap_type), intent(inout) :: map
163
- integer(int8), intent(in) :: test_8_bits(test_size)
197
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
164
198
integer(int_index), intent(in) :: test_block
165
199
type(key_type) :: key
166
200
integer(int_index) :: index2
167
201
logical :: existed
168
202
169
- do index2=1, size(test_8_bits), test_block
170
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
203
+ do index2=1, test_size, test_block
204
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
205
+ call map % remove(key, existed)
206
+ call check(error, existed, "Key not found in entry removal.")
207
+
208
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
209
+ call map % remove(key, existed)
210
+ call check(error, existed, "Key not found in entry removal.")
211
+
212
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
171
213
call map % remove(key, existed)
172
214
call check(error, existed, "Key not found in entry removal.")
173
215
end do
@@ -249,6 +291,7 @@ module test_stdlib_open_maps
249
291
integer, parameter :: test_size = rand_size*4
250
292
integer, parameter :: test_16 = 2**4
251
293
integer, parameter :: test_256 = 2**8
294
+ integer, parameter :: key_types = 3
252
295
253
296
public :: collect_stdlib_open_maps
254
297
@@ -278,7 +321,7 @@ contains
278
321
type(error_type), allocatable, intent(out) :: error
279
322
280
323
type(open_hashmap_type) :: map
281
- integer(int8) :: test_8_bits(test_size)
324
+ integer(int8) :: test_8_bits(test_size,key_types )
282
325
283
326
call generate_vector(test_8_bits)
284
327
@@ -302,29 +345,31 @@ contains
302
345
303
346
304
347
subroutine generate_vector(test_8_bits)
305
- integer(int8), intent(out) :: test_8_bits(test_size)
348
+ integer(int8), intent(out) :: test_8_bits(test_size, key_types )
306
349
307
- integer :: index
350
+ integer :: index, key_type
308
351
real(dp) :: rand2(2)
309
352
integer(int32) :: rand_object(rand_size)
310
-
311
- do index=1, rand_size
312
- call random_number(rand2)
313
- if (rand2(1) < 0.5_dp) then
314
- rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
315
- else
316
- rand_object(index) = floor(rand2(2)*hugep1, int32)
317
- end if
318
- end do
319
-
320
- test_8_bits(:) = transfer( rand_object, 0_int8, test_size )
353
+
354
+ do key_type = 1, key_types
355
+ do index=1, rand_size
356
+ call random_number(rand2)
357
+ if (rand2(1) < 0.5_dp) then
358
+ rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1
359
+ else
360
+ rand_object(index) = floor(rand2(2)*hugep1, int32)
361
+ end if
362
+ end do
363
+
364
+ test_8_bits(:,key_type) = transfer( rand_object, 0_int8, test_size )
365
+ enddo
321
366
322
367
end subroutine
323
368
324
369
subroutine test_input_random_data(error, map, test_8_bits, test_block)
325
370
type(error_type), allocatable, intent(out) :: error
326
371
type(open_hashmap_type), intent(inout) :: map
327
- integer(int8), intent(in) :: test_8_bits(test_size)
372
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
328
373
integer(int_index), intent(in) :: test_block
329
374
class(*), allocatable :: dummy
330
375
type(dummy_type) :: dummy_val
@@ -333,49 +378,81 @@ contains
333
378
type(other_type) :: other
334
379
logical :: conflict
335
380
336
- do index2=1, size(test_8_bits) , test_block
337
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
381
+ do index2=1, test_size , test_block
382
+
338
383
if (allocated(dummy)) deallocate(dummy)
339
- dummy_val % value = test_8_bits( index2:index2+test_block-1 )
384
+ dummy_val % value = test_8_bits( index2:index2+test_block-1, 1 )
340
385
allocate( dummy, source=dummy_val )
341
386
call set ( other, dummy )
387
+
388
+ ! Test all key interfaces
389
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
390
+ call map % map_entry( key, other, conflict )
391
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
392
+
393
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
394
+ call map % map_entry( key, other, conflict )
395
+ call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
396
+
397
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
342
398
call map % map_entry( key, other, conflict )
343
399
call check(error, .not.conflict, "Unable to map entry because of a key conflict.")
400
+
344
401
if (allocated(error)) return
402
+
345
403
end do
346
404
347
405
end subroutine
348
406
349
407
subroutine test_inquire_data(error, map, test_8_bits, test_block)
350
408
type(error_type), allocatable, intent(out) :: error
351
409
type(open_hashmap_type), intent(inout) :: map
352
- integer(int8), intent(in) :: test_8_bits(test_size)
410
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
353
411
integer(int_index), intent(in) :: test_block
354
412
integer :: index2
355
413
logical :: present
356
414
type(key_type) :: key
357
415
358
- do index2=1, size(test_8_bits), test_block
359
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
416
+ do index2=1, test_size, test_block
417
+
418
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
419
+ call map % key_test( key, present )
420
+ call check(error, present, "KEY not found in map KEY_TEST.")
421
+
422
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
360
423
call map % key_test( key, present )
361
424
call check(error, present, "KEY not found in map KEY_TEST.")
425
+
426
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
427
+ call map % key_test( key, present )
428
+ call check(error, present, "KEY not found in map KEY_TEST.")
429
+
362
430
if (allocated(error)) return
431
+
363
432
end do
364
433
365
434
end subroutine
366
435
367
436
subroutine test_get_data(error, map, test_8_bits, test_block)
368
437
type(error_type), allocatable, intent(out) :: error
369
438
type(open_hashmap_type), intent(inout) :: map
370
- integer(int8), intent(in) :: test_8_bits(test_size)
439
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
371
440
integer(int_index), intent(in) :: test_block
372
441
integer :: index2
373
442
type(key_type) :: key
374
443
type(other_type) :: other
375
444
logical :: exists
376
445
377
- do index2=1, size(test_8_bits), test_block
378
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
446
+ do index2=1, test_size, test_block
447
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
448
+ call map % get_other_data( key, other, exists )
449
+ call check(error, exists, "Unable to get data because key not found in map.")
450
+
451
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
452
+ call map % get_other_data( key, other, exists )
453
+ call check(error, exists, "Unable to get data because key not found in map.")
454
+
455
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
379
456
call map % get_other_data( key, other, exists )
380
457
call check(error, exists, "Unable to get data because key not found in map.")
381
458
end do
@@ -385,14 +462,22 @@ contains
385
462
subroutine test_removal(error, map, test_8_bits, test_block)
386
463
type(error_type), allocatable, intent(out) :: error
387
464
type(open_hashmap_type), intent(inout) :: map
388
- integer(int8), intent(in) :: test_8_bits(test_size)
465
+ integer(int8), intent(in) :: test_8_bits(test_size, key_types )
389
466
integer(int_index), intent(in) :: test_block
390
467
type(key_type) :: key
391
468
integer(int_index) :: index2
392
469
logical :: existed
393
470
394
- do index2=1, size(test_8_bits), test_block
395
- call set( key, test_8_bits( index2:index2+test_block-1 ) )
471
+ do index2=1, test_size, test_block
472
+ call set( key, test_8_bits( index2:index2+test_block-1, 1 ) )
473
+ call map % remove(key, existed)
474
+ call check(error, existed, "Key not found in entry removal.")
475
+
476
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), 0_int32 ) )
477
+ call map % remove(key, existed)
478
+ call check(error, existed, "Key not found in entry removal.")
479
+
480
+ call set( key, transfer( test_8_bits( index2:index2+test_block-1, 3 ), char_type ) )
396
481
call map % remove(key, existed)
397
482
call check(error, existed, "Key not found in entry removal.")
398
483
end do
0 commit comments