diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index cb62e81ee..d324fa29b 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -157,11 +157,13 @@ Procedures to manipulate `key_type` data: `key_in`, to contents of the key, `key_out`. * `get( key, value )` - extracts the contents of `key` into `value`, - an `int8` array or character string. + an `int8` array, 'int32' array, or character string. * `free_key( key )` - frees the memory in `key`. -* `set( key, value )` - sets the content of `key` to `value`. +* `set( key, value )` - sets the content of `key` to `value`. + Supported key types are `int8` array, `int32` array, and character + string. Procedures to manipulate `other_type` data: @@ -474,9 +476,9 @@ is an `intent(in)` argument. `value`: if the the first argument is of `key_type` `value` shall be an allocatable default character string variable, or -an allocatable vector variable of type integer and kind `int8`, -otherwise the first argument is of `other_type` and `value` shall be -an allocatable of `class(*)`. It is an `intent(out)` argument. +an allocatable vector variable of type integer and kind `int8` or +`int32`, otherwise the first argument is of `other_type` and `value` +shall be an allocatable of `class(*)`. It is an `intent(out)` argument. ##### Example @@ -751,13 +753,14 @@ is an `intent(out)` argument. `value`: if the first argument is `key` `value` shall be a default character string scalar expression, or a vector expression of type integer -and kind `int8`, while for a first argument of type `other` `value` -shall be of type `class(*)`. It is an `intent(in)` argument. +and kind `int8` or `int32`, while for a first argument of type +`other` `value` shall be of type `class(*)`. It is an `intent(in)` +argument. ##### Note -Values of types other than a scalar default character or an -`int8` vector can be used as the basis of a `key` by transferring the +Values of types other than a scalar default character or and +`int8` or `int32` vector can be used as the basis of a `key` by transferring the value to an `int8` vector. ##### Example diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index a2a8b93d2..0991d9ac3 100644 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -88,6 +88,7 @@ end function hasher_fun module procedure get_char_key, & get_int8_key, & + get_int32_key, & get_other end interface get @@ -101,6 +102,7 @@ end function hasher_fun module procedure set_char_key, & set_int8_key, & + set_int32_key, & set_other end interface set @@ -277,6 +279,21 @@ subroutine get_int8_key( key, value ) end subroutine get_int8_key + pure subroutine get_int32_key( key, value ) +!! Version: Experimental +!! +!! Gets the contents of the key as an INTEGER(INT32) vector +!! Arguments: +!! key - the input key +!! value - the contents of key mapped to an INTEGER(INT32) vector + type(key_type), intent(in) :: key + integer(int32), allocatable, intent(out) :: value(:) + + value = transfer( key % value, value ) + + end subroutine get_int32_key + + subroutine set_char_key( key, value ) !! Version: Experimental !! @@ -323,6 +340,21 @@ subroutine set_int8_key( key, value ) end subroutine set_int8_key + pure subroutine set_int32_key( key, value ) +!! Version: Experimental +!! +!! Sets the contents of the key from an INTEGER(INT32) vector +!! Arguments: +!! key - the output key +!! value - the input INTEGER(INT32) vector + type(key_type), intent(out) :: key + integer(int32), intent(in) :: value(:) + + key % value = transfer(value, key % value) + + end subroutine set_int32_key + + pure function fnv_1_hasher( key ) !! Version: Experimental !! diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp index 835bb9369..5498ebc2e 100644 --- a/test/hashmaps/test_maps.fypp +++ b/test/hashmaps/test_maps.fypp @@ -24,7 +24,9 @@ module test_stdlib_chaining_maps integer, parameter :: test_size = rand_size*4 integer, parameter :: test_16 = 2**4 integer, parameter :: test_256 = 2**8 - + ! key_type = 2 to support int8 and int32 key types tested. Can be + ! increased to generate additional unique int8 vectors additional key types. + integer, parameter :: key_types = 2 public :: collect_stdlib_chaining_maps contains @@ -53,10 +55,9 @@ contains type(error_type), allocatable, intent(out) :: error type(chaining_hashmap_type) :: map - integer(int8) :: test_8_bits(test_size) + 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_}$) @@ -77,29 +78,33 @@ contains subroutine generate_vector(test_8_bits) - integer(int8), intent(out) :: test_8_bits(test_size) + integer(int8), intent(out) :: test_8_bits(test_size, key_types) - integer :: index + integer :: index, key_type real(dp) :: rand2(2) integer(int32) :: rand_object(rand_size) - 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 + ! 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 - test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) - 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) + integer(int8), intent(in) :: test_8_bits(test_size, key_types) integer(int_index), intent(in) :: test_block class(*), allocatable :: dummy type(dummy_type) :: dummy_val @@ -108,14 +113,24 @@ contains type(other_type) :: other logical :: conflict - do index2=1, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + do index2=1, test_size, test_block + if (allocated(dummy)) deallocate(dummy) - dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + dummy_val % value = test_8_bits( index2:index2+test_block-1, 1 ) allocate( dummy, source=dummy_val ) call set ( other, dummy ) + + ! Test base int8 key interface + call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) + call map % map_entry( key, other, 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, other, conflict ) - call check(error, .not.conflict, "Unable to map entry because of a key conflict.") + call check(error, .not.conflict, "Unable to map int32 entry because of a key conflict.") + if (allocated(error)) return end do @@ -124,16 +139,21 @@ contains 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) + 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, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, "KEY not found in map KEY_TEST.") + call check(error, present, "Int32 KEY not found in map KEY_TEST.") + if (allocated(error)) return end do @@ -142,17 +162,21 @@ contains 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) + integer(int8), intent(in) :: test_8_bits(test_size, key_types) integer(int_index), intent(in) :: test_block integer :: index2 type(key_type) :: key type(other_type) :: other logical :: exists - do index2=1, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, other, 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, other, exists ) - call check(error, exists, "Unable to get data because key not found in map.") + call check(error, exists, "Unable to get data because int32 key not found in map.") end do end subroutine @@ -160,16 +184,20 @@ contains 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) + 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, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, "Key not found in entry removal.") + 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.") end do end subroutine @@ -249,6 +277,9 @@ module test_stdlib_open_maps integer, parameter :: test_size = rand_size*4 integer, parameter :: test_16 = 2**4 integer, parameter :: test_256 = 2**8 + ! key_type = 2 to support int8 and int32 key types tested. Can be + ! increased to generate additional unique int8 vectors additional key types. + integer, parameter :: key_types = 2 public :: collect_stdlib_open_maps @@ -278,7 +309,7 @@ contains type(error_type), allocatable, intent(out) :: error type(open_hashmap_type) :: map - integer(int8) :: test_8_bits(test_size) + integer(int8) :: test_8_bits(test_size,key_types) call generate_vector(test_8_bits) @@ -302,29 +333,33 @@ contains subroutine generate_vector(test_8_bits) - integer(int8), intent(out) :: test_8_bits(test_size) + integer(int8), intent(out) :: test_8_bits(test_size, key_types) - integer :: index + integer :: index, key_type real(dp) :: rand2(2) integer(int32) :: rand_object(rand_size) - - 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(:) = transfer( rand_object, 0_int8, test_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) + integer(int8), intent(in) :: test_8_bits(test_size, key_types) integer(int_index), intent(in) :: test_block class(*), allocatable :: dummy type(dummy_type) :: dummy_val @@ -333,14 +368,24 @@ contains type(other_type) :: other logical :: conflict - do index2=1, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + do index2=1, test_size, test_block + if (allocated(dummy)) deallocate(dummy) - dummy_val % value = test_8_bits( index2:index2+test_block-1 ) + dummy_val % value = test_8_bits( index2:index2+test_block-1, 1 ) allocate( dummy, source=dummy_val ) call set ( other, dummy ) + + ! Test base int8 key interface + call set( key, test_8_bits( index2:index2+test_block-1, 1 ) ) call map % map_entry( key, other, conflict ) - call check(error, .not.conflict, "Unable to map entry because of a key 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, other, conflict ) + call check(error, .not.conflict, "Unable to map int32 entry because of a key conflict.") + if (allocated(error)) return end do @@ -349,17 +394,23 @@ contains 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) + 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, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, "KEY not found in map KEY_TEST.") - if (allocated(error)) return + 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.") + + if (allocated(error)) return end do end subroutine @@ -367,17 +418,21 @@ contains 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) + integer(int8), intent(in) :: test_8_bits(test_size, key_types) integer(int_index), intent(in) :: test_block integer :: index2 type(key_type) :: key type(other_type) :: other logical :: exists - do index2=1, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, other, exists ) - call check(error, exists, "Unable to get data because key not found in map.") + 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, other, exists ) + call check(error, exists, "Unable to get data because int32 key not found in map.") end do end subroutine @@ -385,16 +440,20 @@ contains 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) + 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, size(test_8_bits), test_block - call set( key, test_8_bits( index2:index2+test_block-1 ) ) + 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, "Key not found in entry removal.") + call check(error, existed, "Int32 Key not found in entry removal.") end do end subroutine