From 6c3d3dfc05c42ca6d67e14eabeed3921d0a48c89 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sun, 27 Jul 2025 23:22:02 -0400 Subject: [PATCH 1/4] Hashmap-test-update This is a refactor of the main hashmap test routine to improve coverage and simplify the code. The fypp preprocessor directives have been removed to make the code easier to work with and modify for future releases. --- src/stdlib_hashmaps.f90 | 3 +- test/hashmaps/CMakeLists.txt | 9 - test/hashmaps/test_maps.f90 | 455 ++++++++++++++++++++++++++ test/hashmaps/test_maps.fypp | 608 ----------------------------------- 4 files changed, 457 insertions(+), 618 deletions(-) create mode 100644 test/hashmaps/test_maps.f90 delete mode 100644 test/hashmaps/test_maps.fypp diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index d8afb23ec..d90192691 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -33,7 +33,8 @@ module stdlib_hashmaps !! Public data_types public :: & chaining_hashmap_type, & - open_hashmap_type + open_hashmap_type, & + hashmap_type !! Values that parameterize David Chase's empirical SLOT expansion code integer, parameter :: & diff --git a/test/hashmaps/CMakeLists.txt b/test/hashmaps/CMakeLists.txt index 7831dde7d..830ee10eb 100755 --- a/test/hashmaps/CMakeLists.txt +++ b/test/hashmaps/CMakeLists.txt @@ -1,12 +1,3 @@ -### Pre-process: .fpp -> .f90 via Fypp - -# Create a list of the files to be preprocessed -set(fppFiles - test_maps.fypp -) - -fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) - ADDTEST(chaining_maps) ADDTEST(open_maps) ADDTEST(maps) diff --git a/test/hashmaps/test_maps.f90 b/test/hashmaps/test_maps.f90 new file mode 100644 index 000000000..903010da4 --- /dev/null +++ b/test/hashmaps/test_maps.f90 @@ -0,0 +1,455 @@ +module test_hashmaps + use stdlib_hashmaps, only: hashmap_type, chaining_hashmap_type, open_hashmap_type + use stdlib_hashmap_wrappers, only: set, key_type, hasher_fun, fnv_1_hasher, fnv_1a_hasher, & + seeded_nmhash32_hasher, seeded_nmhash32x_hasher, seeded_water_hasher + use stdlib_kinds, only: int8 + use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed + + implicit none + + contains + + ! Top level test drive collector + subroutine collect_hashmap_tests(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + testsuite = [ & + new_unittest("default_chaining", test_default_chaining), & + new_unittest("chaining_fnv1", test_chaining_fnv1), & + new_unittest("chaining_fnv1a", test_chaining_fnv1a), & + new_unittest("chaining_snm32", test_chaining_snm32), & + new_unittest("chaining_snm32x", test_chaining_snm32x), & + new_unittest("chaining_swh", test_chaining_swh), & + new_unittest("default_open", test_default_open), & + new_unittest("open_fnv1", test_open_fnv1), & + new_unittest("open_fnv1a", test_open_fnv1a), & + new_unittest("open_snm32", test_open_snm32), & + new_unittest("open_snm32x", test_open_snm32x), & + new_unittest("open_swh", test_open_swh) & + ] + end subroutine collect_hashmap_tests + + !!! Driver routines for the test configs. + ! Chaining map tests + subroutine test_default_chaining(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "default_chaining") + end subroutine test_default_chaining + + subroutine test_chaining_fnv1(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "chaining_fnv1", fnv_1_hasher) + end subroutine test_chaining_fnv1 + + subroutine test_chaining_fnv1a(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "chaining_fnv1a", fnv_1a_hasher) + end subroutine test_chaining_fnv1a + + subroutine test_chaining_snm32(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "chaining_snm32", seeded_nmhash32_hasher) + end subroutine test_chaining_snm32 + + subroutine test_chaining_snm32x(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "chaining_snm32x", seeded_nmhash32x_hasher) + end subroutine test_chaining_snm32x + + subroutine test_chaining_swh(error) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type) :: chain_map + call run_hashmap_tests(error, chain_map, "chaining_swh", seeded_water_hasher) + end subroutine test_chaining_swh + + ! Open map tests + subroutine test_default_open(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "default_open" ) + end subroutine test_default_open + + subroutine test_open_fnv1(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "open_fnv1", fnv_1_hasher) + end subroutine test_open_fnv1 + + subroutine test_open_fnv1a(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "open_fnv1a", fnv_1a_hasher) + end subroutine test_open_fnv1a + + subroutine test_open_snm32(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "open_snm32", seeded_nmhash32_hasher) + end subroutine test_open_snm32 + + subroutine test_open_snm32x(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "open_snm32x", seeded_nmhash32x_hasher) + end subroutine test_open_snm32x + + subroutine test_open_swh(error) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type) :: open_map + call run_hashmap_tests(error, open_map, "open_swh", seeded_water_hasher) + end subroutine test_open_swh + + + ! Common test routine used for all tests. + subroutine run_hashmap_tests(error, map, name, hasher) + type(error_type), allocatable, intent(out) :: error + class(hashmap_type), intent(inout) :: map + character(len=*), intent(in) :: name + procedure(hasher_fun), optional :: hasher + + integer :: i + logical :: conflict, exists, existed + class(*), allocatable :: data + + integer, parameter :: test_size = 1000 ! Default size is 2^7 = 128 slots. 1000 is big enough to require several map resizes. + + ! Initialize hashmap with the specified hasher if provided. Otherwise will be default initialization. + if (present(hasher)) call map%init(hasher=hasher, slots_bits=7) + + !! Key interface test + block + type(key_type), allocatable :: keys(:) + type(key_type) :: key + + do i = 1, test_size + ! Map entry + call set(key, [i]) + call map%map_entry(key, i, conflict) + call check(error, .not.conflict, "Failure on key interface map_entry for "//trim(name)) + + ! Verify key exists + call map % key_test( key, exists ) + call check(error, exists, "Key doesn't exist after mapping on key interface for "//trim(name)) + + ! Get data and verify it is correct. + call map % get_other_data( key, data, exists ) + call check(error, exists, "Failure on key interface for get_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == i, "Failure on key interface data check for"//trim(name)) + class default + call test_failed(error, "Key interface get_other_data didn't return an integer for "//trim(name)) + end select + + ! Set key to a new value + call map % set_other_data( key, (i+test_size), exists ) + call check(error, exists, "Failure on key interface set_other_data for"//trim(name)) + + ! Get updated value and verify it is correct. + call map % get_other_data( key, data, exists ) + call check(error, exists, "Failure on key interface for get_other_data after set_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == (i+test_size), "Failure on key interface set_other_data data check for"//trim(name)) + class default + call test_failed(error, "Key interface set_other_data get_other_data didn't return an integer for "//trim(name)) + end select + + ! Check entry count and very it matches expected entry count + call check( error, map % entries() == i, "Failure on key interface add entery count for "//trim(name) ) + end do + + ! Check get all keys routine + call map%get_all_keys(keys) + call check(error, size(keys) == test_size, "Failure on key interface for get_all_keys for "//trim(name)) + + ! Check remove and get all keys function + do i = 1, test_size + call set(key, [i]) + + call map % remove(key, existed) + call check(error, existed, "Failure on key interface for remove for "//trim(name)) + + call map % key_test( key, exists ) + call check(error, .not.exists, "Key exists after removal on key interface for "//trim(name)) + + call check( error, map % entries() == (test_size-i), "Failure on key interface remove entery count for "//trim(name) ) + enddo + end block + + ! If error encoutered exit test, as downstream tests may be unpredictable. + if (allocated(error)) return + + !!! Check int8 interface + block + type(key_type), allocatable :: keys(:) + integer(int8), allocatable :: key_array(:) + + do i = 1, test_size + key_array = transfer(i,key_array) + + ! Map entry + call map%map_entry(key_array, i, conflict) + call check(error, .not.conflict, "Failure on int8 interface map_entry for "//trim(name)) + + ! Verify key exists + call map % key_test( key_array, exists ) + call check(error, exists, "Key doesn't exist after mapping on int8 interface for "//trim(name)) + + ! Get data and verify it is correct. + call map % get_other_data( key_array, data, exists ) + call check(error, exists, "Failure on int8 interface for get_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == i, "Failure on int8 interface data check for"//trim(name)) + class default + call test_failed(error, "Int8 interface get_other_data didn't return an integer for "//trim(name)) + end select + + ! Set key to a new value + call map % set_other_data( key_array, (i+test_size), exists ) + call check(error, exists, "Failure on int8 interface set_other_data for"//trim(name)) + + ! Get updated value and verify it is correct. + call map % get_other_data( key_array, data, exists ) + call check(error, exists, "Failure on int8 interface for get_other_data after set_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == (i+test_size), "Failure on int8 interface set_other_data data check for"//trim(name)) + class default + call test_failed(error, "Int8 interface set_other_data get_other_data didn't return an integer for "//trim(name)) + end select + + ! Check entry count and very it matches expected entry count + call check( error, map % entries() == i, "Failure on int8 interface add entery count for "//trim(name) ) + end do + + ! Check get all keys routine + call map%get_all_keys(keys) + call check(error, size(keys) == test_size, "Failure on int8 interface for get_all_keys for "//trim(name)) + + ! Check remove and get all keys function + do i = 1, test_size + key_array = transfer(i,key_array) + + call map % remove(key_array, existed) + call check(error, existed, "Failure on int8 interface for remove for "//trim(name)) + + call map % key_test(key_array, exists ) + call check(error, .not.exists, "Key exists after removal on int8 interface for "//trim(name)) + + call check( error, map % entries() == (test_size-i), "Failure on int8 interface remove entery count for "//trim(name) ) + enddo + end block + + ! If error encoutered exit test, as downstream tests may be unpredictable. + if (allocated(error)) return + + !!! Check int32 interface + block + type(key_type), allocatable :: keys(:) + integer :: key_array(1) + + do i = 1, test_size + key_array = i + + ! Map entry + call map%map_entry(key_array, i, conflict) + call check(error, .not.conflict, "Failure on int32 interface map_entry for "//trim(name)) + + ! Verify key exists + call map % key_test( key_array, exists ) + call check(error, exists, "Key doesn't exist after mapping on int32 interface for "//trim(name)) + + ! Get data and verify it is correct. + call map % get_other_data( key_array, data, exists ) + call check(error, exists, "Failure on int32 interface for get_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == i, "Failure on int32 interface data check for"//trim(name)) + class default + call test_failed(error, "Int32 interface get_other_data didn't return an integer for "//trim(name)) + end select + + ! Set key to a new value + call map % set_other_data( key_array, (i+test_size), exists ) + call check(error, exists, "Failure on int32 interface set_other_data for"//trim(name)) + + ! Get updated value and verify it is correct. + call map % get_other_data( key_array, data, exists ) + call check(error, exists, "Failure on int32 interface for get_other_data after set_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == (i+test_size), "Failure on int32 interface set_other_data data check for"//trim(name)) + class default + call test_failed(error, "Int32 interface set_other_data get_other_data didn't return an integer for "//trim(name)) + end select + + call check( error, map % entries() == i, "Failure on int32 interface add entery count for "//trim(name) ) + end do + + ! Check get all keys routine + call map%get_all_keys(keys) + call check(error, size(keys) == test_size, "Failure on int32 interface for get_all_keys for "//trim(name)) + + ! Check remove and get all keys function + do i = 1, test_size + key_array = i + + call map % remove(key_array, existed) + call check(error, existed, "Failure on int32 interface for remove for "//trim(name)) + + call map % key_test(key_array, exists ) + call check(error, .not.exists, "Key exists after removal on int32 interface for "//trim(name)) + + call check( error, map % entries() == (test_size-i), "Failure on int32 interface remove entery count for "//trim(name) ) + enddo + end block + + ! If error encoutered exit test, as downstream tests may be unpredictable. + if (allocated(error)) return + + !!! Check character interface + block + type(key_type), allocatable :: keys(:) + character(len=16) :: char_key + + do i = 1, test_size + ! Generate a character string for the key + write(char_key, '(I0)') i + + ! Map entry + call map%map_entry(char_key, i, conflict) + call check(error, .not.conflict, "Failure on char interface map_entry for "//trim(name)) + + ! Verify key exists + call map % key_test( char_key, exists ) + call check(error, exists, "Key doesn't exist after mapping on char interface for "//trim(name)) + + ! Get data and verify it is correct. + call map % get_other_data( char_key, data, exists ) + call check(error, exists, "Failure on char interface for get_other_data for"//trim(name)) + + select type(data) + type is (integer) + call check(error, data == i, "Failure on char interface data check for"//trim(name)) + class default + call test_failed(error, "Char interface get_other_data didn't return an integer for "//trim(name)) + end select + + ! Set key to a new value + call map % set_other_data( char_key, (i+test_size), exists ) + call check(error, exists, "Failure on char interface set_other_data for"//trim(name)) + + ! Get updated value and verify it is correct. + call map % get_other_data( char_key, data, exists ) + call check(error, exists, "Failure on char interface for get_other_data after set_other_data for"//trim(name)) + select type(data) + type is (integer) + call check(error, data == (i+test_size), "Failure on char interface set_other_data data check for"//trim(name)) + class default + call test_failed(error, "Char interface set_other_data get_other_data didn't return an integer for "//trim(name)) + end select + + call check( error, map % entries() == i, "Failure on char interface add entery count for "//trim(name) ) + end do + + ! Check get all keys routine + call map%get_all_keys(keys) + call check(error, size(keys) == test_size, "Failure on char interface for get_all_keys for "//trim(name)) + + ! Check remove and get all keys function + do i = 1, test_size + write(char_key, '(I0)') i + + call map % remove(char_key, existed) + call check(error, existed, "Failure on char interface for remove for "//trim(name)) + + call map % key_test(char_key, exists ) + call check(error, .not.exists, "Key exists after removal on char interface for "//trim(name)) + + call check( error, map % entries() == (test_size-i), "Failure on char interface remove entery count for "//trim(name) ) + enddo + end block + + ! If error encoutered exit test, as downstream tests may be unpredictable. + if (allocated(error)) return + + ! Final loading. + do i = 1, test_size + call map%map_entry([i], i) + enddo + + ! Test rehash function. + call map%rehash(fnv_1a_hasher) + + ! Loop back through and verify data is correct. + do i = 1, test_size + call map % get_other_data( [i], data, exists ) + call check(error, exists, "Failure on get_other_data after rehash for"//trim(name)) + + select type(data) + type is (integer) + call check(error, data == i, "Failure on data check after rehash for"//trim(name)) + class default + call test_failed(error, "After rehash didn't return an integer for "//trim(name)) + end select + enddo + + ! Check miscellaneous functions calls + block + real :: ratio + integer :: num_slots, nprobes, depth, bits + + bits = 0 + bits = map%slots_bits() + call check(error, bits > 0, "Slots_bits function failure for "//trim(name)) + + ratio = -1 + ratio = map%loading() + call check(error, ratio > 0, "Loading function failure for"//trim(name)) + + num_slots = -1 + num_slots = map%num_slots() + call check(error, num_slots > 0, "Num_slots function failure for"//trim(name)) + + nprobes = -1 + nprobes = map%map_probes() + call check(error, nprobes > 0, "Map_probes failure for"//trim(name)) + + depth = -1 + depth = map%total_depth() + call check(error, depth > 0, "Total_depth failure for"//trim(name)) + end block + + ! Leaving map with entries to test finalization routine on subroutine exit. + end subroutine run_hashmap_tests + +end module test_hashmaps + + +program main + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only: run_testsuite, new_testsuite, testsuite_type + use test_hashmaps, only: collect_hashmap_tests + + implicit none + + integer :: stat + type(testsuite_type), allocatable :: testsuites(:) + + testsuites = [ new_testsuite("hashmap_tests", collect_hashmap_tests) ] + + stat = 0 + call run_testsuite(testsuites(1)%collect, error_unit, stat) + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "Hashmap tests failed!" + error stop + end if + +end program main diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp deleted file mode 100644 index fea134f3c..000000000 --- a/test/hashmaps/test_maps.fypp +++ /dev/null @@ -1,608 +0,0 @@ -#: include "common.fypp" -#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"] -#:set SIZE_NAME = ["16", "256"] -module test_stdlib_chaining_maps -!! Test various aspects of the runtime system. -!! Running this program may require increasing the stack size to above 48 MBytes -!! or decreasing rand_power to 20 or less - use testdrive, only : new_unittest, unittest_type, error_type, check - use :: stdlib_kinds, only : dp, int8, int32 - use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index - use stdlib_hashmap_wrappers - - implicit none - private - - type dummy_type - integer(int8), allocatable :: value(:) - end type dummy_type - - integer(int32), parameter :: huge32 = huge(0_int32) - real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp - integer, parameter :: rand_power = 18 - integer, parameter :: rand_size = 2**rand_power - integer, parameter :: test_size = rand_size*4 - integer, parameter :: test_16 = 2**4 - integer, parameter :: test_256 = 2**8 - ! key_type = 5 to support int8 and int32 key types tested. Can be - ! increased to generate additional unique int8 vectors additional key types. - integer, parameter :: key_types = 5 - character(len=16) :: char_size - public :: collect_stdlib_chaining_maps - - -contains - - !> Collect all exported unit tests - subroutine collect_stdlib_chaining_maps(testsuite) - !> Collection of tests - type(unittest_type), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - new_unittest("chaining-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & - #:for hash_ in HASH_NAME - #:for size_ in SIZE_NAME - , new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & - #:endfor - #:endfor - , new_unittest("chaining-maps-removal-spec", test_removal_spec) & - ] - - end subroutine collect_stdlib_chaining_maps - - #:for hash_ in HASH_NAME - #:for size_ in SIZE_NAME - subroutine test_${hash_}$_${size_}$_byte_words(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error - - type(chaining_hashmap_type) :: map - integer(int8) :: test_8_bits(test_size,key_types) - - call generate_vector(test_8_bits) - call map % init( ${hash_}$, slots_bits=10 ) - - call test_input_random_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_inquire_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_get_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_removal(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - end subroutine - #:endfor - #:endfor - - - subroutine generate_vector(test_8_bits) - integer(int8), intent(out) :: test_8_bits(test_size, key_types) - - integer :: index, key_type - real(dp) :: rand2(2) - integer(int32) :: rand_object(rand_size) - - ! Generate a unique int8 vector for each key type tested to avoid - ! dupilcate keys and mapping conflicts. - do key_type = 1, key_types - do index=1, rand_size - call random_number(rand2) - if (rand2(1) < 0.5_dp) then - rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 - else - rand_object(index) = floor(rand2(2)*hugep1, int32) - end if - end do - - test_8_bits(:,key_type) = transfer( rand_object, 0_int8, test_size ) - end do - - end subroutine - - subroutine test_input_random_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(chaining_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - type(dummy_type) :: dummy_val - integer :: index2 - type(key_type) :: key - - logical :: conflict - - do index2=1, test_size, test_block - - ! Test base int8 key interface - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % map_entry( key, dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map int8 entry because of a key conflict.") - - ! Test int32 key interface - ! Use transfer to create int32 vector from generated int8 vector. - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % map_entry( key, dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map chaining int32 entry because of a key conflict.") - - ! Test int8 key generic interface - call map % map_entry( test_8_bits( index2:index2+test_block-1, 3 ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map chaining int8 generic interface") - - ! Test int32 key generic interface - call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map chaining int32 generic interface") - - ! Test char key generic interface - call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map chaining character generic interface") - - if (allocated(error)) return - end do - - end subroutine - - subroutine test_inquire_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(chaining_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - integer :: index2 - logical :: present - type(key_type) :: key - - do index2=1, test_size, test_block - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % key_test( key, present ) - call check(error, present, "Int8 KEY not found in map KEY_TEST.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % key_test( key, present ) - call check(error, present, "Int32 KEY not found in map KEY_TEST.") - - call map % key_test( test_8_bits( index2:index2+test_block-1, 3 ), present ) - call check(error, present, "Int8 KEY generic interface not found in map KEY_TEST.") - - call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), present ) - call check(error, present, "Int32 KEY generic interface not found in map KEY_TEST.") - - call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), present ) - call check(error, present, "Char KEY generic interface not found in map KEY_TEST.") - - if (allocated(error)) return - end do - - end subroutine - - subroutine test_get_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(chaining_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - integer :: index2 - type(key_type) :: key - class(*), allocatable :: data - logical :: exists - - do index2=1, test_size, test_block - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % get_other_data( key, data, exists ) - call check(error, exists, "Unable to get data because int8 key not found in map.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % get_other_data( key, data, exists ) - call check(error, exists, "Unable to get data because int32 key not found in map.") - - call map % get_other_data( test_8_bits( index2:index2+test_block-1, 3 ), data, exists ) - call check(error, exists, "Unable to get data because int8 generic interface key not found in map.") - - call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ) , data, exists ) - call check(error, exists, "Unable to get data because int32 generic interface key not found in map.") - - call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ) , data, exists ) - call check(error, exists, "Unable to get data because character generic interface key not found in map.") - end do - - end subroutine - - subroutine test_removal(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(chaining_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - type(key_type) :: key - integer(int_index) :: index2 - logical :: existed - - do index2=1, test_size, test_block - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % remove(key, existed) - call check(error, existed, "Int8 Key not found in entry removal.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % remove(key, existed) - call check(error, existed, "Int32 Key not found in entry removal.") - - call map % remove(test_8_bits( index2:index2+test_block-1, 3 ), existed) - call check(error, existed, "Int8 Key generic interface not found in entry removal.") - - call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), existed) - call check(error, existed, "Int32 Key generic interface not found in entry removal.") - - call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), existed) - call check(error, existed, "Character Key generic interface not found in entry removal.") - end do - - end subroutine - - subroutine test_removal_spec(error) - !! Test following code provided by @jannisteunissen - !! https://github.com/fortran-lang/stdlib/issues/785 - type(error_type), allocatable, intent(out) :: error - - type(chaining_hashmap_type) :: map - type(key_type) :: key - integer, parameter :: n_max = 500 - integer :: n - integer, allocatable :: key_counts(:) - integer, allocatable :: seed(:) - integer(int8) :: int32_int8(4) - integer(int32) :: keys(n_max) - real(dp) :: r_uniform(n_max) - logical :: existed, present - - call random_seed(size = n) - allocate(seed(n), source = 123456) - call random_seed(put = seed) - - call random_number(r_uniform) - keys = nint(r_uniform * n_max * 0.25_dp) - - call map%init(fnv_1_hasher, slots_bits=10) - - do n = 1, n_max - call set(key, transfer(keys(n), int32_int8)) - call map%key_test(key, present) - if (present) then - call map%remove(key, existed) - call check(error, existed, "chaining-removal-spec: Key not found in entry removal.") - return - else - call map%map_entry(key) - end if - end do - - ! Count number of keys that occur an odd number of times - allocate(key_counts(minval(keys):maxval(keys)), source = 0) - do n = 1, n_max - key_counts(keys(n)) = key_counts(keys(n)) + 1 - end do - n = sum(iand(key_counts, 1)) - - call check(error, map%entries(), n, & - "chaining-removal-spec: Number of expected keys and entries are different.") - return - - end subroutine - -end module - -module test_stdlib_open_maps -!! Test various aspects of the runtime system. -!! Running this program may require increasing the stack size to above 48 MBytes -!! or decreasing rand_power to 20 or less - use testdrive, only : new_unittest, unittest_type, error_type, check - use :: stdlib_kinds, only : dp, int8, int32 - use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index - use stdlib_hashmap_wrappers - - implicit none - private - - type dummy_type - integer(int8), allocatable :: value(:) - end type dummy_type - - integer(int32), parameter :: huge32 = huge(0_int32) - real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp - integer, parameter :: rand_power = 18 - integer, parameter :: rand_size = 2**rand_power - integer, parameter :: test_size = rand_size*4 - integer, parameter :: test_16 = 2**4 - integer, parameter :: test_256 = 2**8 - ! key_type = 5 to support int8 and int32 key types tested. Can be - ! increased to generate additional unique int8 vectors additional key types. - integer, parameter :: key_types = 5 - character(len=16) :: char_size - - public :: collect_stdlib_open_maps - -contains - - !> Collect all exported unit tests - subroutine collect_stdlib_open_maps(testsuite) - !> Collection of tests - type(unittest_type), allocatable, intent(out) :: testsuite(:) - - testsuite = [ & - new_unittest("open-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & - #:for hash_ in HASH_NAME - #:for size_ in SIZE_NAME - , new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & - #:endfor - #:endfor - , new_unittest("open-maps-removal-spec", test_removal_spec) & - ] - - end subroutine collect_stdlib_open_maps - - #:for hash_ in HASH_NAME - #:for size_ in SIZE_NAME - subroutine test_${hash_}$_${size_}$_byte_words(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error - - type(open_hashmap_type) :: map - integer(int8) :: test_8_bits(test_size,key_types) - - call generate_vector(test_8_bits) - - call map % init( ${hash_}$, slots_bits=10 ) - - call test_input_random_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_inquire_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_get_data(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - call test_removal(error, map, test_8_bits, test_${size_}$) - if (allocated(error)) return - - end subroutine - #:endfor - #:endfor - - - subroutine generate_vector(test_8_bits) - integer(int8), intent(out) :: test_8_bits(test_size, key_types) - - integer :: index, key_type - real(dp) :: rand2(2) - integer(int32) :: rand_object(rand_size) - - ! Generate a unique int8 vector for each key type tested to avoid - ! dupilcate keys and mapping conflicts. - do key_type = 1, key_types - do index=1, rand_size - call random_number(rand2) - if (rand2(1) < 0.5_dp) then - rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 - else - rand_object(index) = floor(rand2(2)*hugep1, int32) - end if - end do - - test_8_bits(:,key_type) = transfer( rand_object, 0_int8, test_size ) - enddo - - end subroutine - - subroutine test_input_random_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(open_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - type(dummy_type) :: dummy_val - integer :: index2 - type(key_type) :: key - logical :: conflict - - do index2=1, test_size, test_block - - ! Test base int8 key interface - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % map_entry( key, dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map int8 entry because of a key conflict.") - - ! Test int32 key interface - ! Use transfer to create int32 vector from generated int8 vector. - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % map_entry( key, dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map int32 entry because of a key conflict.") - - ! Test int8 generic key interface - call map % map_entry( test_8_bits( index2:index2+test_block-1, 3 ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map int8 generic key interface entry because of a key conflict.") - - ! Test int32 key generic interface - call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map open int32 generic key interface entry because of a key conflict.") - - ! Test character key generic interface - call map % map_entry( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), dummy_val, conflict ) - call check(error, .not.conflict, "Unable to map open character generic key interface entry because of a key conflict.") - - if (allocated(error)) return - end do - - end subroutine - - subroutine test_inquire_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(open_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - integer :: index2 - logical :: present - type(key_type) :: key - - do index2=1, test_size, test_block - - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % key_test( key, present ) - call check(error, present, "Int8 KEY not found in map KEY_TEST.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % key_test( key, present ) - call check(error, present, "Int32 KEY not found in map KEY_TEST.") - - call map % key_test( test_8_bits( index2:index2+test_block-1, 3 ), present ) - call check(error, present, "Int8 KEY generic interface not found in map KEY_TEST.") - - call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), present ) - call check(error, present, "Int32 KEY generic interface not found in map KEY_TEST.") - - call map % key_test( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), present ) - call check(error, present, "Character KEY generic interface not found in map KEY_TEST.") - - if (allocated(error)) return - end do - - end subroutine - - subroutine test_get_data(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(open_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - integer :: index2 - type(key_type) :: key - class(*), allocatable :: data - logical :: exists - - do index2=1, test_size, test_block - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % get_other_data( key, data, exists ) - call check(error, exists, "Unable to get data because int8 key not found in map.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % get_other_data( key, data, exists ) - call check(error, exists, "Unable to get data because int32 key not found in map.") - - call map % get_other_data( test_8_bits( index2:index2+test_block-1, 3 ), data, exists ) - call check(error, exists, "Unable to get data because int8 generic interface key not found in map.") - - call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), data, exists ) - call check(error, exists, "Unable to get data because int32 generic interface key not found in map.") - - call map % get_other_data( transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), data, exists ) - call check(error, exists, "Unable to get data because character generic interface key not found in map.") - end do - - end subroutine - - subroutine test_removal(error, map, test_8_bits, test_block) - type(error_type), allocatable, intent(out) :: error - type(open_hashmap_type), intent(inout) :: map - integer(int8), intent(in) :: test_8_bits(test_size, key_types) - integer(int_index), intent(in) :: test_block - type(key_type) :: key - integer(int_index) :: index2 - logical :: existed - - do index2=1, test_size, test_block - call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) - call map % remove(key, existed) - call check(error, existed, "Int8 Key not found in entry removal.") - - call set( key, transfer( test_8_bits( index2:index2+test_block-1, 2 ), [0_int32] ) ) - call map % remove(key, existed) - call check(error, existed, "Int32 Key not found in entry removal.") - - call map % remove( test_8_bits( index2:index2+test_block-1, 3 ), existed) - call check(error, existed, "Int8 Key generic interface not found in entry removal.") - - call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 4 ), [0_int32] ), existed) - call check(error, existed, "Int32 Key generic interface not found in entry removal.") - - call map % remove(transfer( test_8_bits( index2:index2+test_block-1, 5 ), char_size ), existed) - call check(error, existed, "Character Key generic interface not found in entry removal.") - end do - - end subroutine - - subroutine test_removal_spec(error) - !! Test following code provided by @jannisteunissen - !! https://github.com/fortran-lang/stdlib/issues/785 - type(error_type), allocatable, intent(out) :: error - - type(open_hashmap_type) :: map - type(key_type) :: key - integer, parameter :: n_max = 500 - integer :: n - integer, allocatable :: key_counts(:) - integer, allocatable :: seed(:) - integer(int8) :: int32_int8(4) - integer(int32) :: keys(n_max) - real(dp) :: r_uniform(n_max) - logical :: existed, present - - call random_seed(size = n) - allocate(seed(n), source = 123456) - call random_seed(put = seed) - - call random_number(r_uniform) - keys = nint(r_uniform * n_max * 0.25_dp) - - call map%init(fnv_1_hasher, slots_bits=10) - - do n = 1, n_max - call set(key, transfer(keys(n), int32_int8)) - call map%key_test(key, present) - if (present) then - call map%remove(key, existed) - call check(error, existed, "open-removal-spec: Key not found in entry removal.") - return - else - call map%map_entry(key) - end if - end do - - ! Count number of keys that occur an odd number of times - allocate(key_counts(minval(keys):maxval(keys)), source = 0) - do n = 1, n_max - key_counts(keys(n)) = key_counts(keys(n)) + 1 - end do - n = sum(iand(key_counts, 1)) - - call check(error, map%entries(), n, & - "open-removal-spec: Number of expected keys and entries are different.") - return - - end subroutine - -end module - - -program tester - use, intrinsic :: iso_fortran_env, only : error_unit - use testdrive, only : run_testsuite, new_testsuite, testsuite_type - use test_stdlib_open_maps, only : collect_stdlib_open_maps - use test_stdlib_chaining_maps, only : collect_stdlib_chaining_maps - implicit none - integer :: stat, is - type(testsuite_type), allocatable :: testsuites(:) - character(len=*), parameter :: fmt = '("#", *(1x, a))' - - stat = 0 - - testsuites = [ & - new_testsuite("stdlib-open-maps", collect_stdlib_open_maps) & - , new_testsuite("stdlib-chaining-maps", collect_stdlib_chaining_maps) & - ] - - do is = 1, size(testsuites) - write(error_unit, fmt) "Testing:", testsuites(is)%name - call run_testsuite(testsuites(is)%collect, error_unit, stat) - end do - - if (stat > 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" - error stop - end if -end program From 0b312887b8de35d63399641e3975d82e21138c22 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sun, 27 Jul 2025 23:45:47 -0400 Subject: [PATCH 2/4] Update test_maps.f90 Addressed 132 character limit issues. --- test/hashmaps/test_maps.f90 | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/test/hashmaps/test_maps.f90 b/test/hashmaps/test_maps.f90 index 903010da4..0b976d58b 100644 --- a/test/hashmaps/test_maps.f90 +++ b/test/hashmaps/test_maps.f90 @@ -219,9 +219,11 @@ subroutine run_hashmap_tests(error, map, name, hasher) call check(error, exists, "Failure on int8 interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), "Failure on int8 interface set_other_data data check for"//trim(name)) + call check(error, data == (i+test_size), & + "Failure on int8 interface set_other_data data check for"//trim(name)) class default - call test_failed(error, "Int8 interface set_other_data get_other_data didn't return an integer for "//trim(name)) + call test_failed(error, & + "Int8 interface set_other_data get_other_data didn't return an integer for "//trim(name)) end select ! Check entry count and very it matches expected entry count @@ -242,7 +244,8 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map % key_test(key_array, exists ) call check(error, .not.exists, "Key exists after removal on int8 interface for "//trim(name)) - call check( error, map % entries() == (test_size-i), "Failure on int8 interface remove entery count for "//trim(name) ) + call check( error, map % entries() == (test_size-i), & + "Failure on int8 interface remove entery count for "//trim(name) ) enddo end block @@ -284,9 +287,11 @@ subroutine run_hashmap_tests(error, map, name, hasher) call check(error, exists, "Failure on int32 interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), "Failure on int32 interface set_other_data data check for"//trim(name)) + call check(error, data == (i+test_size), & + "Failure on int32 interface set_other_data data check for"//trim(name)) class default - call test_failed(error, "Int32 interface set_other_data get_other_data didn't return an integer for "//trim(name)) + call test_failed(error, & + "Int32 interface set_other_data get_other_data didn't return an integer for "//trim(name)) end select call check( error, map % entries() == i, "Failure on int32 interface add entery count for "//trim(name) ) @@ -347,12 +352,15 @@ subroutine run_hashmap_tests(error, map, name, hasher) ! Get updated value and verify it is correct. call map % get_other_data( char_key, data, exists ) - call check(error, exists, "Failure on char interface for get_other_data after set_other_data for"//trim(name)) + call check(error, exists, & + "Failure on char interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), "Failure on char interface set_other_data data check for"//trim(name)) + call check(error, data == (i+test_size), & + "Failure on char interface set_other_data data check for"//trim(name)) class default - call test_failed(error, "Char interface set_other_data get_other_data didn't return an integer for "//trim(name)) + call test_failed(error, & + "Char interface set_other_data get_other_data didn't return an integer for "//trim(name)) end select call check( error, map % entries() == i, "Failure on char interface add entery count for "//trim(name) ) @@ -372,7 +380,8 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map % key_test(char_key, exists ) call check(error, .not.exists, "Key exists after removal on char interface for "//trim(name)) - call check( error, map % entries() == (test_size-i), "Failure on char interface remove entery count for "//trim(name) ) + call check( error, map % entries() == (test_size-i), & + "Failure on char interface remove entery count for "//trim(name) ) enddo end block From b1dab28def652ce56cc07e7ebf9ec09c6ca7f109 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 28 Jul 2025 08:47:01 -0400 Subject: [PATCH 3/4] Update test_maps.f90 Minor cleanup --- test/hashmaps/test_maps.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/test/hashmaps/test_maps.f90 b/test/hashmaps/test_maps.f90 index 0b976d58b..577cc595b 100644 --- a/test/hashmaps/test_maps.f90 +++ b/test/hashmaps/test_maps.f90 @@ -146,7 +146,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) end select ! Set key to a new value - call map % set_other_data( key, (i+test_size), exists ) + call map % set_other_data( key, -i, exists ) call check(error, exists, "Failure on key interface set_other_data for"//trim(name)) ! Get updated value and verify it is correct. @@ -154,7 +154,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call check(error, exists, "Failure on key interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), "Failure on key interface set_other_data data check for"//trim(name)) + call check(error, data == -i, "Failure on key interface set_other_data data check for"//trim(name)) class default call test_failed(error, "Key interface set_other_data get_other_data didn't return an integer for "//trim(name)) end select @@ -167,7 +167,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map%get_all_keys(keys) call check(error, size(keys) == test_size, "Failure on key interface for get_all_keys for "//trim(name)) - ! Check remove and get all keys function + ! Check key remove do i = 1, test_size call set(key, [i]) @@ -211,7 +211,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) end select ! Set key to a new value - call map % set_other_data( key_array, (i+test_size), exists ) + call map % set_other_data( key_array, -i, exists ) call check(error, exists, "Failure on int8 interface set_other_data for"//trim(name)) ! Get updated value and verify it is correct. @@ -219,7 +219,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call check(error, exists, "Failure on int8 interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), & + call check(error, data == -i, & "Failure on int8 interface set_other_data data check for"//trim(name)) class default call test_failed(error, & @@ -234,7 +234,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map%get_all_keys(keys) call check(error, size(keys) == test_size, "Failure on int8 interface for get_all_keys for "//trim(name)) - ! Check remove and get all keys function + ! Check key remove do i = 1, test_size key_array = transfer(i,key_array) @@ -279,7 +279,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) end select ! Set key to a new value - call map % set_other_data( key_array, (i+test_size), exists ) + call map % set_other_data( key_array, -i, exists ) call check(error, exists, "Failure on int32 interface set_other_data for"//trim(name)) ! Get updated value and verify it is correct. @@ -287,7 +287,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call check(error, exists, "Failure on int32 interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), & + call check(error, data == -i, & "Failure on int32 interface set_other_data data check for"//trim(name)) class default call test_failed(error, & @@ -301,7 +301,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map%get_all_keys(keys) call check(error, size(keys) == test_size, "Failure on int32 interface for get_all_keys for "//trim(name)) - ! Check remove and get all keys function + ! Check key remove do i = 1, test_size key_array = i @@ -347,7 +347,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) end select ! Set key to a new value - call map % set_other_data( char_key, (i+test_size), exists ) + call map % set_other_data( char_key, -i, exists ) call check(error, exists, "Failure on char interface set_other_data for"//trim(name)) ! Get updated value and verify it is correct. @@ -356,7 +356,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) "Failure on char interface for get_other_data after set_other_data for"//trim(name)) select type(data) type is (integer) - call check(error, data == (i+test_size), & + call check(error, data == -i, & "Failure on char interface set_other_data data check for"//trim(name)) class default call test_failed(error, & @@ -370,7 +370,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) call map%get_all_keys(keys) call check(error, size(keys) == test_size, "Failure on char interface for get_all_keys for "//trim(name)) - ! Check remove and get all keys function + ! Check key remove do i = 1, test_size write(char_key, '(I0)') i @@ -409,7 +409,7 @@ subroutine run_hashmap_tests(error, map, name, hasher) end select enddo - ! Check miscellaneous functions calls + ! Check miscellaneous functions block real :: ratio integer :: num_slots, nprobes, depth, bits From 8303b2b59ed66ed9fff15ff4a9f0aa47313518ad Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Fri, 1 Aug 2025 22:26:20 -0400 Subject: [PATCH 4/4] Abstract type example Add example of using abstract hashmap_type for procedure interrface. --- example/hashmaps/CMakeLists.txt | 1 + .../example_hashmaps_abstract_type.f90 | 53 +++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 example/hashmaps/example_hashmaps_abstract_type.f90 diff --git a/example/hashmaps/CMakeLists.txt b/example/hashmaps/CMakeLists.txt index 83133adfd..455d024d4 100644 --- a/example/hashmaps/CMakeLists.txt +++ b/example/hashmaps/CMakeLists.txt @@ -1,3 +1,4 @@ +ADD_EXAMPLE(hashmaps_abstract_type) ADD_EXAMPLE(hashmaps_calls) ADD_EXAMPLE(hashmaps_copy_key) ADD_EXAMPLE(hashmaps_entries) diff --git a/example/hashmaps/example_hashmaps_abstract_type.f90 b/example/hashmaps/example_hashmaps_abstract_type.f90 new file mode 100644 index 000000000..65558d6c4 --- /dev/null +++ b/example/hashmaps/example_hashmaps_abstract_type.f90 @@ -0,0 +1,53 @@ + +! For procedure interfaces, consider using abstract hashmap_type for interface definition. +! This allows the procedure to be used for both chaining and open hashmap types. + +program example_abstract_type + use stdlib_kinds, only: int8, int64 + use stdlib_hashmaps, only: chaining_hashmap_type, open_hashmap_type, hashmap_type + + implicit none + + integer :: out_value + type(chaining_hashmap_type) :: chaining_map + type(open_hashmap_type) :: open_map + + ! Chaining map call + call put_int(chaining_map, '1', 1) + call get_int(chaining_map, '1', out_value) + print *, "Chaining out value is ", out_value + + ! Open map call + call put_int(open_map, '1', 1) + call get_int(open_map, '1', out_value) + print *, "Open out value is ", out_value + + contains + + subroutine put_int(map, key, value) + class(hashmap_type), intent(inout) :: map + character(len=*), intent(in) :: key + integer, intent(in) :: value + + call map%map_entry(key, value) + end subroutine put_int + + + subroutine get_int(map, key, value) + class(hashmap_type), intent(inout) :: map + character(len=*), intent(in) :: key + integer, intent(out) :: value + class(*), allocatable :: data + + call map%get_other_data( key, data) + + select type (data) + type is (integer) + value = data + class default + print *, 'Invalid data type in other' + end select + end subroutine get_int + + +end program example_abstract_type