From 51a55dfac426392b473c0fe998da61633e1654a7 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sat, 29 Jun 2024 23:23:41 -0400 Subject: [PATCH 01/47] RC1 Update to hashmap routines to remove 'other' data derived wrapper type. --- .../hashmaps/example_hashmaps_copy_other.f90 | 3 + .../hashmaps/example_hashmaps_free_other.f90 | 3 + .../example_hashmaps_get_all_keys.f90 | 10 +-- .../example_hashmaps_get_other_data.f90 | 37 +++++------ .../hashmaps/example_hashmaps_map_entry.f90 | 29 ++++++--- example/hashmaps/example_hashmaps_remove.f90 | 16 ++--- .../example_hashmaps_set_other_data.f90 | 23 ++++--- src/stdlib_hashmap_chaining.f90 | 18 +++--- src/stdlib_hashmap_open.f90 | 12 ++-- src/stdlib_hashmaps.f90 | 44 ++++++------- test/hashmaps/test_chaining_maps.f90 | 4 +- test/hashmaps/test_maps.fypp | 61 ++++++++----------- test/hashmaps/test_open_maps.f90 | 4 +- 13 files changed, 135 insertions(+), 129 deletions(-) diff --git a/example/hashmaps/example_hashmaps_copy_other.f90 b/example/hashmaps/example_hashmaps_copy_other.f90 index a9d9c03e1..b97d273c8 100644 --- a/example/hashmaps/example_hashmaps_copy_other.f90 +++ b/example/hashmaps/example_hashmaps_copy_other.f90 @@ -1,3 +1,6 @@ +!! This example left for reference, however 'other_type' has largely +!! been depreciated in the stdlib hashmaps. + program example_copy_other use stdlib_hashmap_wrappers, only: & copy_other, other_type diff --git a/example/hashmaps/example_hashmaps_free_other.f90 b/example/hashmaps/example_hashmaps_free_other.f90 index 6f4a0f292..3910f346b 100644 --- a/example/hashmaps/example_hashmaps_free_other.f90 +++ b/example/hashmaps/example_hashmaps_free_other.f90 @@ -1,3 +1,6 @@ +!! This example left for reference, however 'other_type' has largely +!! been depreciated in stdlib hashmaps. + program example_free_other use stdlib_hashmap_wrappers, only: & copy_other, free_other, other_type diff --git a/example/hashmaps/example_hashmaps_get_all_keys.f90 b/example/hashmaps/example_hashmaps_get_all_keys.f90 index 2a91cd1ab..591c61476 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -6,7 +6,6 @@ program example_hashmaps_get_all_keys implicit none type(chaining_hashmap_type) :: map type(key_type) :: key - type(other_type) :: other type(key_type), allocatable :: keys(:) integer(int32) :: i @@ -17,16 +16,13 @@ program example_hashmaps_get_all_keys ! adding key-value pairs to the map call set(key, "initial key") - call set(other, "value 1") - call map%map_entry(key, other) + call map%map_entry(key, "value 1") call set(key, "second key") - call set(other, "value 2") - call map%map_entry(key, other) + call map%map_entry(key, "value 2") call set(key, "last key") - call set(other, "value 3") - call map%map_entry(key, other) + call map%map_entry(key, "value 3") ! getting all the keys in the map call map%get_all_keys(keys) diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index 195857bb7..0ca984e36 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -5,7 +5,7 @@ program example_get_other_data implicit none logical :: conflict type(key_type) :: key - type(other_type) :: other + type(chaining_hashmap_type) :: map type dummy_type integer :: value(4) @@ -21,17 +21,18 @@ program example_get_other_data ! Hashmap functions are setup to store scalar value types (other). Use a dervied ! type wrapper to store arrays. dummy%value = [4, 3, 2, 1] - call set(other, dummy) ! Explicitly set key type using set function call set(key, [0, 1]) - call map%map_entry(key, other, conflict) + call map%map_entry(key, dummy, conflict) if (.not. conflict) then - call map%get_other_data(key, other) + call map%get_other_data(key, data) else error stop 'Key is already present in the map.' end if - call get(other, data) + + ! Get_other_data returns data as an unlimited polymorphic scalar. + ! To use this type in other operations, there must be a select type operation. select type (data) type is (dummy_type) print *, 'Other data % value = ', data%value @@ -41,13 +42,13 @@ program example_get_other_data ! Also can use map_entry and get_other_data generic key interfaces. ! This is an exmple with integer arrays. - call map%map_entry( [2,3], other, conflict) + call map%map_entry( [2,3], dummy, conflict) if (.not. conflict) then - call map%get_other_data( [2,3], other) + call map%get_other_data( [2,3], data) else error stop 'Key is already present in the map.' end if - call get(other, data) + select type (data) type is (dummy_type) print *, 'Other data % value = ', data%value @@ -55,15 +56,15 @@ program example_get_other_data print *, 'Invalid data type in other' end select - ! Integer scalars need to be passed as an array. + ! Integer scalar keys need to be passed as an array. int_scalar = 2 - call map%map_entry( [int_scalar], other, conflict) + call map%map_entry( [int_scalar], dummy, conflict) if (.not. conflict) then - call map%get_other_data( [int_scalar], other) + call map%get_other_data( [int_scalar], data) else error stop 'Key is already present in the map.' end if - call get(other, data) + select type (data) type is (dummy_type) print *, 'Other data % value = ', data%value @@ -72,13 +73,13 @@ program example_get_other_data end select ! Example using character type key interface - call map%map_entry( 'key_string', other, conflict) + call map%map_entry( 'key_string', dummy, conflict) if (.not. conflict) then - call map%get_other_data( 'key_string', other) + call map%get_other_data( 'key_string', data) else error stop 'Key is already present in the map.' end if - call get(other, data) + select type (data) type is (dummy_type) print *, 'Other data % value = ', data%value @@ -88,13 +89,13 @@ program example_get_other_data ! Transfer to int8 arrays to generate key for unsupported types. key_array = transfer( [0_int64, 1_int64], [0_int8] ) - call map%map_entry( key_array, other, conflict) + call map%map_entry( key_array, dummy, conflict) if (.not. conflict) then - call map%get_other_data( key_array, other) + call map%get_other_data( key_array, data) else error stop 'Key is already present in the map.' end if - call get(other, data) + select type (data) type is (dummy_type) print *, 'Other data % value = ', data%value diff --git a/example/hashmaps/example_hashmaps_map_entry.f90 b/example/hashmaps/example_hashmaps_map_entry.f90 index 9ad2e7b7a..dc76d88ea 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -6,38 +6,49 @@ program example_map_entry type(chaining_hashmap_type) :: map type(key_type) :: key logical :: conflict - type(other_type) :: other integer :: int_scalar + type :: array_data_wrapper + integer, allocatable :: array(:) + end type + + type(array_data_wrapper) :: array_example + + ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - ! Initialize other type with data to store. - call set(other, 4) ! Explicitly set key using set function call set(key, [1, 2, 3]) - call map%map_entry(key, other, conflict) + call map%map_entry(key, 4, conflict) print *, 'CONFLICT = ', conflict ! Using map_entry int32 array interface - call map%map_entry( [4, 5, 6], other, conflict) + call map%map_entry( [4, 5, 6], 4, conflict) print *, 'CONFLICT = ', conflict ! Integer scalars need to be passed as an array. int_scalar = 1 - call map%map_entry( [int_scalar], other, conflict) + call map%map_entry( [int_scalar], 4, conflict) print *, 'CONFLICT = ', conflict ! Using map_entry character interface - call map%map_entry( 'key_string', other, conflict) + call map%map_entry( 'key_string', 4, conflict) print *, 'CONFLICT = ', conflict ! Transfer unsupported key types to int8 arrays. - call map%map_entry( transfer( [1_int64, 2_int64, 3_int64], [0_int8] ), other, conflict) + call map%map_entry( transfer( [1_int64, 2_int64, 3_int64], [0_int8] ), 4, conflict) print *, 'CONFLICT = ', conflict -! Keys can be mapped alone without a corresponding value (other). +! Keys can be mapped alone without a corresponding value (other) for 'Set' type functionality. call map%map_entry( [7, 8, 9], conflict=conflict) print *, 'CONFLICT = ', conflict + +! Currently only scalar data can be mapped. +! Arrays will need a wrapper. + array_example % array = [1,2,3,4,5] + call map % map_entry( [10,11,12], array_example, conflict=conflict ) + print *, 'CONFLICT = ', conflict + end program example_map_entry diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 3bac098f5..105757a56 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -6,41 +6,37 @@ program example_remove implicit none type(open_hashmap_type) :: map type(key_type) :: key - type(other_type) :: other logical :: existed integer :: int_scalar ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - - ! Initialize other type with data to store. - call set(other, 4.0) - + ! Explicitly set key type using set function call set(key, [1, 2, 3]) - call map%map_entry(key, other) + call map%map_entry(key, 4.0) call map%remove(key, existed) print *, "Removed key existed = ", existed ! Using map_entry and remove int32 generic interface. - call map%map_entry([1, 2, 3], other) + call map%map_entry([1, 2, 3], 4.0) call map%remove([1, 2, 3], existed) print *, "Removed key existed = ", existed ! Integer scalars need to be passed as an array. int_scalar = 1 - call map%map_entry( [int_scalar], other) + call map%map_entry( [int_scalar], 4.0) call map%remove( [int_scalar], existed) print *, "Removed key existed = ", existed ! Using map_entry and remove character generic interface. - call map%map_entry('key_string', other) + call map%map_entry('key_string', 4.0) call map%remove('key_string', existed) print *, "Removed key existed = ", existed ! Use transfer to int8 arrays for unsupported key types. - call map%map_entry( transfer( [1_int64, 2_int64], [0_int8] ), other) + call map%map_entry( transfer( [1_int64, 2_int64], [0_int8] ), 4.0) call map%remove( transfer( [1_int64,2_int64], [0_int8] ), existed) print *, "Removed key existed = ", existed end program example_remove diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index 133ab994e..8ba5baf59 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -6,18 +6,27 @@ program example_set_other_data implicit none logical :: exists type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other + class(*), allocatable :: data ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - call set(key, [5, 7, 4, 13]) - call set(other, 'A value') - call map%map_entry(key, other) + + call map%map_entry([5, 7, 4, 13], 'A value') + + call map%set_other_data([5, 7, 4, 13], 'Another value', exists) - call set(other, 'Another value') - call map%set_other_data(key, other, exists) print *, 'The entry to have its other data replaced exists = ', exists + call map%get_other_data( [5, 7, 4, 13], data) + + ! Hashmaps return an unlimited polymorphic type as other. + ! Must be included in a select type operation to do further operations. + select type (data) + type is (character(*)) + print *, 'Value is = ', data + class default + print *, 'Invalid data type in other' + end select + end program example_set_other_data diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index b121f90a9..2fb5dd606 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -327,7 +327,7 @@ module subroutine get_other_chaining_data( map, key, other, exists ) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists integer(int_index) :: inmap @@ -345,7 +345,7 @@ module subroutine get_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then if (present(exists) ) exists = .true. - call copy_other( map % inverse(inmap) % target % other, other ) + other = map % inverse(inmap) % target % other else if ( present(exists) ) then exists = .false. @@ -535,7 +535,7 @@ module subroutine map_chain_entry(map, key, other, conflict) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict integer(int_hash) :: hash_index @@ -568,8 +568,7 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - if ( present(other) ) call copy_other( other, new_ent % other ) - + if ( present(other) ) new_ent % other = other if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries @@ -793,7 +792,7 @@ module subroutine set_other_chaining_data( map, key, other, exists ) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists integer(int_index) :: inmap @@ -811,9 +810,10 @@ module subroutine set_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then associate( target => map % inverse(inmap) % target ) - call copy_other( other, target % other ) - if ( present(exists) ) exists = .true. - return + + target % other = other + if ( present(exists) ) exists = .true. + return end associate else error stop submodule_name // ' % ' // procedure // ': ' // & diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index b271f9869..c1867d3ac 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -297,7 +297,7 @@ module subroutine get_other_open_data( map, key, other, exists ) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists integer(int_index) :: inmap @@ -315,7 +315,7 @@ module subroutine get_other_open_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then if ( present(exists) ) exists = .true. - call copy_other( map % inverse(inmap) % target % other, other ) + other = map % inverse(inmap) % target % other else if ( present(exists) ) then exists = .false. @@ -525,7 +525,7 @@ module subroutine map_open_entry(map, key, other, conflict) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict type(open_map_entry_type), pointer :: new_ent @@ -554,7 +554,7 @@ module subroutine map_open_entry(map, key, other, conflict) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) if ( present( other ) ) & - call copy_other( other, new_ent % other ) + new_ent % other = other inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap @@ -822,7 +822,7 @@ module subroutine set_other_open_data( map, key, other, exists ) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out),optional :: exists integer(int_index) :: inmap @@ -841,7 +841,7 @@ module subroutine set_other_open_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then associate( target => map % inverse(inmap) % target ) - call copy_other( other, target % other ) + target % other = other if ( present(exists) ) exists = .true. return end associate diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index d7da35dea..0fbc96365 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -131,7 +131,7 @@ module stdlib_hashmaps generic, public :: map_entry => key_map_entry, int8_map_entry, int32_map_entry, char_map_entry ! Get_other_data procedures - procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data + procedure(key_get_other_data), deferred, pass(map) :: key_get_other_data procedure, non_overridable, pass(map) :: int8_get_other_data procedure, non_overridable, pass(map) :: int32_get_other_data procedure, non_overridable, pass(map) :: char_get_other_data @@ -184,7 +184,7 @@ subroutine key_get_other_data( map, key, other, exists ) import hashmap_type, key_type, other_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists end subroutine key_get_other_data @@ -257,7 +257,7 @@ subroutine key_map_entry(map, key, other, conflict) import hashmap_type, key_type, other_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict end subroutine key_map_entry @@ -305,7 +305,7 @@ subroutine key_set_other_data( map, key, other, exists ) import hashmap_type, key_type, other_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists end subroutine key_set_other_data @@ -319,7 +319,7 @@ function total_depth( map ) !! map - a hash map import hashmap_type, int64 class(hashmap_type), intent(in) :: map - integer(int64) :: total_depth + integer(int64) :: total_depth end function total_depth end interface @@ -336,7 +336,7 @@ end function total_depth !! Full hash value type(key_type) :: key !! The entry's key - type(other_type) :: other + class(*), allocatable :: other !! Other entry data integer(int_index) :: inmap !! Index into inverse table @@ -434,7 +434,7 @@ module subroutine get_other_chaining_data( map, key, other, exists ) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists end subroutine get_other_chaining_data @@ -503,7 +503,7 @@ module subroutine map_chain_entry(map, key, other, conflict) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict end subroutine map_chain_entry @@ -550,7 +550,7 @@ module subroutine set_other_chaining_data( map, key, other, exists ) ! class(chaining_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists end subroutine set_other_chaining_data @@ -580,7 +580,7 @@ end function total_chaining_depth !! Full hash value type(key_type) :: key !! Hash entry key - type(other_type) :: other + class(*), allocatable :: other !! Other entry data integer(int_index) :: inmap !! Index into inverse table @@ -684,7 +684,7 @@ module subroutine get_other_open_data( map, key, other, exists ) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists end subroutine get_other_open_data @@ -754,7 +754,7 @@ module subroutine map_open_entry(map, key, other, conflict) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict end subroutine map_open_entry @@ -799,7 +799,7 @@ module subroutine set_other_open_data( map, key, other, exists ) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists end subroutine set_other_open_data @@ -828,7 +828,7 @@ subroutine int8_get_other_data( map, value, other, exists ) class(hashmap_type), intent(inout) :: map integer(int8), intent(in) :: value(:) - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists type(key_type) :: key @@ -847,7 +847,7 @@ subroutine int32_get_other_data( map, value, other, exists ) class(hashmap_type), intent(inout) :: map integer(int32), intent(in) :: value(:) - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists type(key_type) :: key @@ -866,7 +866,7 @@ subroutine char_get_other_data( map, value, other, exists ) class(hashmap_type), intent(inout) :: map character(*), intent(in) :: value - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists type(key_type) :: key @@ -954,7 +954,7 @@ subroutine int8_map_entry(map, value, other, conflict) !! class(hashmap_type), intent(inout) :: map integer(int8), intent(in) :: value(:) - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict type(key_type) :: key @@ -974,7 +974,7 @@ subroutine int32_map_entry(map, value, other, conflict) !! class(hashmap_type), intent(inout) :: map integer(int32), intent(in) :: value(:) - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict type(key_type) :: key @@ -994,7 +994,7 @@ subroutine char_map_entry(map, value, other, conflict) !! class(hashmap_type), intent(inout) :: map character(len=*), intent(in) :: value - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict type(key_type) :: key @@ -1094,7 +1094,7 @@ subroutine int8_set_other_data( map, value, other, exists ) ! class(hashmap_type), intent(inout) :: map integer(int8), intent(in) :: value(:) - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists type(key_type) :: key @@ -1120,7 +1120,7 @@ subroutine int32_set_other_data( map, value, other, exists ) ! class(hashmap_type), intent(inout) :: map integer(int32), intent(in) :: value(:) - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists type(key_type) :: key @@ -1146,7 +1146,7 @@ subroutine char_set_other_data( map, value, other, exists ) ! class(hashmap_type), intent(inout) :: map character(*), intent(in) :: value - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists type(key_type) :: key diff --git a/test/hashmaps/test_chaining_maps.f90 b/test/hashmaps/test_chaining_maps.f90 index 13d062118..0a178f637 100755 --- a/test/hashmaps/test_chaining_maps.f90 +++ b/test/hashmaps/test_chaining_maps.f90 @@ -218,14 +218,14 @@ subroutine test_get_data( map, test_block, hash_name, size_name ) character(*), intent(in) :: hash_name, size_name integer :: index2 type(key_type) :: key - type(other_type) :: other + class(*), allocatable :: data logical :: exists real :: t1, t2, tdiff call cpu_time(t1) do index2=1, size(test_8_bits), test_block call set( key, test_8_bits( index2:index2+test_block-1 ) ) - call map % get_other_data( key, other, exists ) + call map % get_other_data( key, data, exists ) if (.not. exists) & error stop "Unable to get data because key not found in map." end do diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp index 4de9aa334..fea134f3c 100644 --- a/test/hashmaps/test_maps.fypp +++ b/test/hashmaps/test_maps.fypp @@ -108,41 +108,35 @@ contains 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 - class(*), allocatable :: dummy type(dummy_type) :: dummy_val integer :: index2 type(key_type) :: key - type(other_type) :: other + logical :: conflict do index2=1, test_size, test_block - - if (allocated(dummy)) deallocate(dummy) - 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 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, other, conflict ) + 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 ), other, conflict ) + 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] ), other, conflict ) + 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 ), other, conflict ) + 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 @@ -189,25 +183,25 @@ contains integer(int_index), intent(in) :: test_block integer :: index2 type(key_type) :: key - type(other_type) :: other + 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, other, exists ) + 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, other, exists ) + 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 ), other, exists ) + 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] ) , other, exists ) + 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 ) , other, exists ) + 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 @@ -403,41 +397,34 @@ contains 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 - class(*), allocatable :: dummy type(dummy_type) :: dummy_val integer :: index2 type(key_type) :: key - type(other_type) :: other logical :: conflict do index2=1, test_size, test_block - - if (allocated(dummy)) deallocate(dummy) - 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 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, other, conflict ) + 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 ), other, conflict ) + 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] ), other, conflict ) + 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 ), other, conflict ) + 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 @@ -485,25 +472,25 @@ contains integer(int_index), intent(in) :: test_block integer :: index2 type(key_type) :: key - type(other_type) :: other + 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, other, exists ) + 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, other, exists ) + 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 ), other, exists ) + 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] ), other, exists ) + 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 ), other, exists ) + 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 diff --git a/test/hashmaps/test_open_maps.f90 b/test/hashmaps/test_open_maps.f90 index 7e1ff9764..2607c8aa7 100755 --- a/test/hashmaps/test_open_maps.f90 +++ b/test/hashmaps/test_open_maps.f90 @@ -219,14 +219,14 @@ subroutine test_get_data( map, test_block, hash_name, size_name ) character(*), intent(in) :: hash_name, size_name integer :: index2 type(key_type) :: key - type(other_type) :: other + class(*), allocatable :: data logical :: exists real :: t1, t2, tdiff call cpu_time(t1) do index2=1, size(test_8_bits), test_block call set( key, test_8_bits( index2:index2+test_block-1 ) ) - call map % get_other_data( key, other, exists ) + call map % get_other_data( key, data, exists ) if (.not. exists) & error stop "Unable to get data because key not found in map." end do From 18882808d98ba5fac1915d0eadfcbda7755d61c8 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 2 Jul 2024 22:30:12 -0400 Subject: [PATCH 02/47] Update src/stdlib_hashmap_chaining.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_hashmap_chaining.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 2fb5dd606..7dcd7d256 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -345,7 +345,7 @@ module subroutine get_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then if (present(exists) ) exists = .true. - other = map % inverse(inmap) % target % other + allocate(other, source = map % inverse(inmap) % target % other) else if ( present(exists) ) then exists = .false. From fa23a44f872fdf6578ce4928e26ff58664e68f49 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 2 Jul 2024 22:30:51 -0400 Subject: [PATCH 03/47] Update src/stdlib_hashmap_open.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_hashmap_open.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index c1867d3ac..bd04cf3a7 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -841,7 +841,7 @@ module subroutine set_other_open_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then associate( target => map % inverse(inmap) % target ) - target % other = other + target % other = other if ( present(exists) ) exists = .true. return end associate From 18ed909bd2f5727f5a523f562dfa2cbf929c00e9 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 2 Jul 2024 22:31:25 -0400 Subject: [PATCH 04/47] Update src/stdlib_hashmap_chaining.f90 Co-authored-by: Jeremie Vandenplas --- src/stdlib_hashmap_chaining.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 7dcd7d256..2efabd353 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -810,7 +810,6 @@ module subroutine set_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then associate( target => map % inverse(inmap) % target ) - target % other = other if ( present(exists) ) exists = .true. return From 97ae06de26caeba13eb0dd466d54fb21b99353bd Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 2 Jul 2024 22:48:22 -0400 Subject: [PATCH 05/47] Other_type cleanup and removal Remove reference of other_type that were missed in the initial commits. --- src/stdlib_hashmap_open.f90 | 2 +- src/stdlib_hashmaps.f90 | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index c1867d3ac..f98b2d287 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -297,7 +297,7 @@ module subroutine get_other_open_data( map, key, other, exists ) ! class(open_hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key - class(*), allocatable, intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists integer(int_index) :: inmap diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 0fbc96365..b96bd8a59 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -32,7 +32,6 @@ module stdlib_hashmaps seeded_water_hasher, & set, & key_type, & - other_type, & int_hash implicit none @@ -181,7 +180,7 @@ subroutine key_get_other_data( map, key, other, exists ) !! other - the other data associated with the key !! exists - a logical flag indicating whether an entry with that key exists ! - import hashmap_type, key_type, other_type + import hashmap_type, key_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key class(*), allocatable, intent(out) :: other @@ -254,7 +253,7 @@ subroutine key_map_entry(map, key, other, conflict) !! Inserts an entry into the hash table !! ([Specifications](../page/specs/stdlib_hashmaps.html#map_entry-inserts-an-entry-into-the-hash-map)) !! - import hashmap_type, key_type, other_type + import hashmap_type, key_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key class(*), intent(in), optional :: other @@ -302,7 +301,7 @@ subroutine key_set_other_data( map, key, other, exists ) !! in the map !! ! - import hashmap_type, key_type, other_type + import hashmap_type, key_type class(hashmap_type), intent(inout) :: map type(key_type), intent(in) :: key class(*), intent(in) :: other From 1906b4c88f4ba8ede4933b9828558939fcdf31a2 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 2 Jul 2024 23:10:29 -0400 Subject: [PATCH 06/47] Remove other type from test_chaining and test_open --- test/hashmaps/test_chaining_maps.f90 | 7 +------ test/hashmaps/test_open_maps.f90 | 10 ++++------ 2 files changed, 5 insertions(+), 12 deletions(-) diff --git a/test/hashmaps/test_chaining_maps.f90 b/test/hashmaps/test_chaining_maps.f90 index 0a178f637..48a0f9f1e 100755 --- a/test/hashmaps/test_chaining_maps.f90 +++ b/test/hashmaps/test_chaining_maps.f90 @@ -161,22 +161,17 @@ subroutine input_random_data( map, test_block, hash_name, size_name ) integer(int_index), intent(in) :: test_block character(*), intent(in) :: hash_name character(*), intent(in) :: size_name - class(*), allocatable :: dummy type(dummy_type) :: dummy_val integer :: index2 type(key_type) :: key - type(other_type) :: other real :: t1, t2, tdiff logical :: conflict call cpu_time(t1) do index2=1, size(test_8_bits), test_block call set( key, test_8_bits( index2:index2+test_block-1 ) ) - if (allocated(dummy)) deallocate(dummy) dummy_val % value = test_8_bits( index2:index2+test_block-1 ) - allocate( dummy, source=dummy_val ) - call set ( other, dummy ) - call map % map_entry( key, other, conflict ) + call map % map_entry( key, dummy_val, conflict ) if (conflict) & error stop "Unable to map entry because of a key conflict." end do diff --git a/test/hashmaps/test_open_maps.f90 b/test/hashmaps/test_open_maps.f90 index 2607c8aa7..869c5fdeb 100755 --- a/test/hashmaps/test_open_maps.f90 +++ b/test/hashmaps/test_open_maps.f90 @@ -162,22 +162,20 @@ subroutine input_random_data( map, test_block, hash_name, size_name ) integer(int_index), intent(in) :: test_block character(*), intent(in) :: hash_name character(*), intent(in) :: size_name - class(*), allocatable :: dummy + type(dummy_type) :: dummy_val integer :: index2 type(key_type) :: key - type(other_type) :: other real :: t1, t2, tdiff logical :: conflict call cpu_time(t1) do index2=1, size(test_8_bits), test_block call set( key, test_8_bits( index2:index2+test_block-1 ) ) - if (allocated(dummy)) deallocate(dummy) + dummy_val % value = test_8_bits( index2:index2+test_block-1 ) - allocate( dummy, source=dummy_val ) - call set ( other, dummy ) - call map % map_entry( key, other, conflict ) + + call map % map_entry( key, dummy_val, conflict ) if (conflict) & error stop "Unable to map entry because of a key conflict." end do From a52302d5552fe94278d8bd78b67bddda5db05b1b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 3 Jul 2024 11:38:02 -0400 Subject: [PATCH 07/47] Update stdlib_hashmap_chaining.f90 In progress check to understand in-line allocation of other. --- src/stdlib_hashmap_chaining.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 2efabd353..a0f5cbeb4 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -345,7 +345,8 @@ module subroutine get_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then if (present(exists) ) exists = .true. - allocate(other, source = map % inverse(inmap) % target % other) + !allocate(other, source = map % inverse(inmap) % target % other) + other = map % inverse(inmap) % target % other else if ( present(exists) ) then exists = .false. From a31b2f9f5d9be6ba14ab5aa51352a955ea980cd9 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 3 Jul 2024 12:19:18 -0400 Subject: [PATCH 08/47] Update example_hashmaps_set_other_data.f90 Tweak to see why CI test fails for this. --- example/hashmaps/example_hashmaps_set_other_data.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index 8ba5baf59..d8a4c3d5d 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -2,7 +2,7 @@ program example_set_other_data use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, other_type, set + fnv_1a_hasher implicit none logical :: exists type(open_hashmap_type) :: map @@ -18,7 +18,9 @@ program example_set_other_data print *, 'The entry to have its other data replaced exists = ', exists - call map%get_other_data( [5, 7, 4, 13], data) + call map%get_other_data( [5, 7, 4, 13], data, exists) + + print *, 'Get_other_data was successful = ', exists ! Hashmaps return an unlimited polymorphic type as other. ! Must be included in a select type operation to do further operations. From f47b4c5949767a0a7dab46ccd9596b25b1ed30cb Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 3 Jul 2024 23:00:03 -0400 Subject: [PATCH 09/47] Update CMakeLists.txt Test to see if stack size increase addresses CI failure. --- example/CMakeLists.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cbef7f075..37db584fc 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -4,6 +4,10 @@ macro(ADD_EXAMPLE name) add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) + + if ( ${CMAKE_HOST_SYSTEM_NAME} STREQUAL "Windows") + target_link_options(example_${name} PRIVATE "LINKER:-stack:10000000") + endif() endmacro(ADD_EXAMPLE) add_subdirectory(array) From ed99423cbf10f948b8c7e66bdeb480872f6e32c7 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 4 Jul 2024 08:55:02 -0400 Subject: [PATCH 10/47] Update CMakeLists.txt Add double hyphen for GCC nomenclature. --- example/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 37db584fc..3994adf46 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -6,7 +6,7 @@ macro(ADD_EXAMPLE name) WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) if ( ${CMAKE_HOST_SYSTEM_NAME} STREQUAL "Windows") - target_link_options(example_${name} PRIVATE "LINKER:-stack:10000000") + target_link_options(example_${name} PRIVATE "LINKER:--stack:10000000") endif() endmacro(ADD_EXAMPLE) From 3d1adc8fbbe1c06ca10d262ba7762c31f85607b3 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 4 Jul 2024 09:38:28 -0400 Subject: [PATCH 11/47] Update CMakeLists.txt Bug fix on linker line --- example/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 3994adf46..b44b07703 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -6,7 +6,7 @@ macro(ADD_EXAMPLE name) WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) if ( ${CMAKE_HOST_SYSTEM_NAME} STREQUAL "Windows") - target_link_options(example_${name} PRIVATE "LINKER:--stack:10000000") + target_link_options(example_${name} PRIVATE "LINKER:--stack,10000000") endif() endmacro(ADD_EXAMPLE) From 50ae9613aa608508d93455d031f886d63d190eec Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 4 Jul 2024 09:55:51 -0400 Subject: [PATCH 12/47] Revert "Update CMakeLists.txt" Revert example/CMakesLists.txt back to original. --- example/CMakeLists.txt | 3 --- 1 file changed, 3 deletions(-) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index b44b07703..d767016ee 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -4,9 +4,6 @@ macro(ADD_EXAMPLE name) add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) - - if ( ${CMAKE_HOST_SYSTEM_NAME} STREQUAL "Windows") - target_link_options(example_${name} PRIVATE "LINKER:--stack,10000000") endif() endmacro(ADD_EXAMPLE) From d5f098ee2934bbbc3bca5ae56d6dc47a05061868 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 4 Jul 2024 10:02:45 -0400 Subject: [PATCH 13/47] Update CMakeLists.txt Bugfix --- example/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index d767016ee..cbef7f075 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -4,7 +4,6 @@ macro(ADD_EXAMPLE name) add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) - endif() endmacro(ADD_EXAMPLE) add_subdirectory(array) From b10a851d65561ee026633810f74a91a332569a4e Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 4 Jul 2024 16:55:08 -0400 Subject: [PATCH 14/47] Update example_hashmaps_set_other_data.f90 Test to see if updating to chaining hashmaps fixes the single CI failure. --- example/hashmaps/example_hashmaps_set_other_data.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index d8a4c3d5d..f90feee8d 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -1,11 +1,11 @@ program example_set_other_data use stdlib_kinds, only: int8 - use stdlib_hashmaps, only: open_hashmap_type + use stdlib_hashmaps, only: open_hashmap_type, chaining_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher, & fnv_1a_hasher implicit none logical :: exists - type(open_hashmap_type) :: map + type(chaining_hashmap_type) :: map class(*), allocatable :: data ! Initialize hashmap with 2^10 slots. From cba213d49a5f3030c8fe036173fe59650483216c Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sat, 6 Jul 2024 23:05:50 -0400 Subject: [PATCH 15/47] Update stdlib_hashmaps.md --- doc/specs/stdlib_hashmaps.md | 229 +++++++++++------------------------ 1 file changed, 68 insertions(+), 161 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 94b42413f..c796654be 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -43,11 +43,9 @@ use by `stdlib_hashmaps`. It provides an interface to the 32 bit hash functions of the Standard Library module, `stdlib_hash_32bit`, and provides wrappers to some of the hash functions so that they no longer need to be supplied seeds. It -also defines two data types used to store information in the hash -maps, the `key_type` and the `other_type`. The `key_type` is used to +also defines the `key_type` derived type. The `key_type` is used to define keys that, in turn, are used to identify the data entered into -a hash map. The `other_type` is intended to contain the other data -associated with the key. +a hash map. The module `stdlib_hashmaps` defines the API for a parent datatype, `hashmap_type` and two extensions of that hash map type: @@ -88,8 +86,8 @@ the ratio of the number of hash map probes to the number of subroutine calls. Wile the maps make extensive use of pointers internally, a private finalization subroutine avoids memory leaks. -The maps can take entry keys of type `key_type`, and other data of the -type `other_type`. +The maps can take entry keys of type `key_type`, and other data (also +commonly known as values, as in key value pairs) in any scalar type. The maps allow the addition, removal, and lookup of entries, and the inclusion of data in addition to the entry key. @@ -118,27 +116,18 @@ value, `int32`. ### The `stdlib_hashmap_wrappers`' module's derived types -The `stdlib_hashmap_wrappers` module defines two derived types: -`key_type`, and `other_type`. The `key_type` is intended to be used -for the search keys of hash tables. The `other_type` is intended to -store additional data associated with a key. Both types are -opaque. Their current representations are as follows +The `stdlib_hashmap_wrappers` defines `key_type` which is intended to +be used for the search keys of hash tables. The tye is opaque. +The current representation is as follows ```fortran type :: key_type private integer(int8), allocatable :: value(:) end type key_type - - type :: other_type - private - class(*), allocatable :: value - end type other_type ``` - The module also defines six procedures for those types: `copy_key`, -`copy_other`, `equal_keys`, `free_key`, `free_other`, `get`, and -`set`, and one operator, `==`, +`equal_keys`, `free_key`, `get`, `set`, and one operator, `==`, for use by the hash maps to manipulate or inquire of components of those types. @@ -146,10 +135,9 @@ those types. The `stdlib_hashmap_wrappers` module provides procedures in several categories: procedures to manipulate data of the `key_type`; -procedures to manipulate data of the `other_type`, and 32 bit hash -functions for keys. The procedures in each category are listed -below. It also provides an operator to compare two key type values for -equality. +and 32 bit hash functions for keys. The procedures in each category +are listed below. It also provides an operator to compare two key +type values for equality. Procedures to manipulate `key_type` data: @@ -165,20 +153,6 @@ Procedures to manipulate `key_type` data: Supported key types are `int8` array, `int32` array, and character string. -Procedures to manipulate `other_type` data: - -* `copy_other( other_in, other_out )` - Copies the contents of the - other data, `other_in`, to the contents of the other data, - `other_out`. - -* `get( other, value )` - extracts the contents of `other` into the - `class(*)` variable `value`. - -* `set( other, value )` - sets the content of `other` to the `class(*)` - variable `value`. - -* `free_other( other )` - frees the memory in `other`. - Procedures to hash keys to 32 bit integers: * `fnv_1_hasher( key )` - hashes a `key` using the FNV-1 algorithm. @@ -232,38 +206,6 @@ is an `intent(out)` argument. {!example/hashmaps/example_hashmaps_copy_key.f90!} ``` -#### `copy_other` - Returns a copy of the other data - -##### Status - -Experimental - -##### Description - -Returns a copy of an input of type `other_type`. - -##### Syntax - -`call ` [[stdlib_hashmap_wrappers:copy_other]] `( other_in, other_out )` - -##### Class - -Subroutine. - -##### Arguments - -`other_in`: shall be a scalar expression of type `other_type`. It -is an `intent(in)` argument. - -`other_out`: shall be a scalar variable of type `other_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran -{!example/hashmaps/example_hashmaps_copy_other.f90!} -``` - #### `fibonacci_hash` - maps an integer to a smaller number of bits @@ -323,7 +265,6 @@ This code does not pass any of the SMHasher tests, but the resulting degradation in performance due to its larger number of collisions is expected to be minor compared to its faster hashing rate. - ##### Example ```fortran @@ -375,13 +316,13 @@ This code does not pass any of the SMHasher tests, but the resulting degradation in performance due to its larger number of collisions is expected to be minor compared to its faster hashing rate. - ##### Example ```fortran {!example/hashmaps/example_hashmaps_fnv_1a_hasher.f90!} ``` + #### `free_key` - frees the memory associated with a key ##### Status @@ -412,36 +353,6 @@ is an `intent(out)` argument. {!example/hashmaps/example_hashmaps_free_key.f90!} ``` -#### `free_other` - frees the memory associated with other data - -##### Status - -Experimental - -##### Description - -Deallocates the memory associated with a variable of type -`other_type`. - -##### Syntax - -`call ` [[stdlib_hashmap_wrappers:free_other]] `( other )` - -##### Class - -Subroutine. - -##### Argument - -`other`: shall be a scalar variable of type `other_type`. It -is an `intent(out)` argument. - -##### Example - -```fortran -{!example/hashmaps/example_hashmaps_free_other.f90!} -``` - #### `get` - extracts the data from a derived type @@ -451,17 +362,13 @@ Experimental ##### Description -Extracts the data from a `key_type` or `other_type` and stores it -in the variable `value`. +Extracts the data from a `key_type` and stores it in the +variable `value`. ##### Syntax `call ` [[stdlib_hashmap_wrappers:get]] `( key, value )` -or - -`call ` [[stdlib_hashmap_wrappers:get]] `( other, value )` - ##### Class Subroutine. @@ -471,14 +378,9 @@ Subroutine. `key`: shall be a scalar expression of type `key_type`. It is an `intent(in)` argument. -`other`: shall be a scalar expression of type `other_type`. It -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` or -`int32`, otherwise the first argument is of `other_type` and `value` -shall be an allocatable of `class(*)`. It is an `intent(out)` argument. +`value`: shall be an allocatable default `character` string variable, +or an allocatable vector variable of type `integer` and kind `int8` or +`int32`. ##### Example @@ -530,6 +432,7 @@ pointers intended for use as a hash function for the hash maps. {!example/hashmaps/example_hashmaps_hasher_fun.f90!} ``` + #### `operator(==)` - Compares two keys for equality ##### Status @@ -570,6 +473,7 @@ The result is `.true.` if the keys are equal, otherwise `.falss.`. {!example/hashmaps/example_hashmaps_equal_keys.f90!} ``` + #### `seeded_nmhash32_hasher`- calculates a hash code from a key ##### Status @@ -613,13 +517,13 @@ As a result it should give fair performance for typical hash map applications. This code passes the SMHasher tests. - ##### Example ```fortran {!example/hashmaps/example_hashmaps_seeded_nmhash32_hasher.f90!} ``` + #### `seeded_nmhash32x_hasher`- calculates a hash code from a key ##### Status @@ -669,6 +573,7 @@ This code passes the SMHasher tests. {!example/hashmaps/example_hashmaps_seeded_nmhash32x_hasher.f90!} ``` + #### `seeded_water_hasher`- calculates a hash code from a key ##### Status @@ -712,7 +617,6 @@ As a result it should give reasonable performance for typical hash table applications. This code passes the SMHasher tests. - ##### Example ```fortran @@ -728,17 +632,12 @@ Experimental ##### Description -Places the data from `value` in a `key_type` or an `other_type`. +Places the data from `value` in a `key_type`. ##### Syntax `call ` [[stdlib_hashmap_wrappers:set]] `( key, value )` -or - -`call ` [[stdlib_hashmap_wrappers:set]] `( other, value )` - - ##### Class Subroutine. @@ -748,14 +647,9 @@ Subroutine. `key`: shall be a scalar variable of type `key_type`. It is an `intent(out)` argument. -`other`: shall be a scalar variable of type `other_type`. It -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` or `int32`, while for a first argument of type -`other` `value` shall be of type `class(*)`. It is an `intent(in)` -argument. +`value`: shall be a default `character` string scalar expression, +or a vector expression of type `integer`and kind `int8` or `int32`. +It is an `intent(in)` argument. ##### Note @@ -906,7 +800,7 @@ and ten deferred procedures: * `get_all_keys` - gets all the keys contained in a map; -* `get_other_data` - gets the other map data associated with the key; +* `get_other_data` - gets the value associated with a key; * `init` - initializes the hash map; @@ -916,14 +810,14 @@ and ten deferred procedures: * `loading` - returns the ratio of the number of entries to the number of slots; -* `map_entry` - inserts a key and its other associated data into the - map; +* `map_entry` - inserts a key and optionally a corresponding value into + the map; * `rehash` - rehashes the map with the provided hash function; * `remove` - removes the entry associated wit the key; -* `set_other_data` - replaces the other data associated with the key; +* `set_other_data` - replaces the value associated with a key; * `total_depth` - returns the number of probes needed to address all the entries in the map; @@ -1003,7 +897,7 @@ the inverse table. The type's definition is below: private integer(int_hash) :: hash_val ! Full hash value type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data + class(*), allocatable :: other ! Other entry data integer(int_index) :: index ! Index into inverse table type(chaining_map_entry_type), pointer :: & next => null() ! Next bucket @@ -1011,6 +905,7 @@ the inverse table. The type's definition is below: ``` Currently the `int_hash` and `int_index` have the value of `int32`. + #### The `chaining_map_entry_ptr` derived type The type `chaining_map_entry_ptr` is used to define the elements of @@ -1024,6 +919,7 @@ containing the elements of the table. The type's definition is below: end type chaining_map_entry_ptr ``` + #### The `chaining_map_entry_pool` derived type The type `chaining_map_entry_pool` is used to implement a pool of @@ -1086,6 +982,7 @@ as follows: end type chaining_hashmap_type ``` + #### The `open_map_entry_type` derived type Entities of the type `open_map_entry_type` are used to define @@ -1098,13 +995,14 @@ the inverse table. The type's definition is below: private integer(int_hash) :: hash_val ! Full hash value type(key_type) :: key ! The entry's key - type(other_type) :: other ! Other entry data + class(*), allocatable :: other ! Other entry data integer(int_index) :: index ! Index into inverse table end type open_map_entry_type ``` Currently `int_hash` and `int_index` have the value of `int32`. + #### The `open_map_entry_ptr` derived type The type `open_map_entry_ptr` is used to define the elements of @@ -1118,6 +1016,7 @@ containing the elements of the table. The type's definition is below: end type open_map_entry_ptr ``` + #### The `open_hashmap_type` derived type The `open_hashmap_type` derived type extends the `hashmap_type` to @@ -1164,6 +1063,7 @@ as follows: end type open_hashmap_type ``` + ### Table of `stdlib_hashmap` procedures The `stdlib_hashmap` module provides procedures in @@ -1185,21 +1085,21 @@ Procedure to modify the structure of a map: Procedures to modify the content of a map: -* `map % map_entry( key, other, conflict )` - Inserts an entry into the +* `map % map_entry( key[, other, conflict] )` - Inserts an entry into the hash map. -* `map % remove( key, existed )` - Remove the entry, if any, +* `map % remove( key[, existed] )` - Remove the entry, if any, associated with the `key`. -* `map % set_other_data( key, other, exists )` - Change the other data - associated with the entry. +* `map % set_other_data( key, other[, exists] )` - Change the value +associated with the `key`. Procedures to report the content of a map: * `map % get_all_keys( all_keys )` - Returns all the keys contained in the map; -* `map % get_other_data( key, other, exists )` - Returns the other data +* `map % get_other_data( key, other[, exists] )` - Returns the value associated with the `key`; * `map % key_test( key, present)` - Returns a flag indicating whether @@ -1345,7 +1245,7 @@ Experimental ##### Description -Returns the other data associated with the `key`, +Returns the value associated with the `key`, ##### Syntax @@ -1365,9 +1265,9 @@ Subroutine `key`: shall be a of type `key_type` scalar, `character` scalar, `int8` array or `int32` array. It is an `intent(in)` argument. -`other`: shall be a variable of type `other_data`. - It is an `intent(out)` argument. It is the other data associated - with the `key`. +`other`: shall be a allocatable unlimited polymorphic scalar. +(class(*), allocatable) It is an `intent(out)` argument. +It is the value associated with the `key`. `exists` (optional): shall be a variable of type logical. It is an `intent(out)` argument. If `.true.` an entry with the given `key` @@ -1379,7 +1279,6 @@ undefined. The following is an example of the retrieval of other data associated with a `key`: - ```fortran {!example/hashmaps/example_hashmaps_get_other_data.f90!} ``` @@ -1478,8 +1377,8 @@ are examined. or `int32` array. It is an `intent(in)` argument. It is a `key` whose presence in the `map` is being examined. -`present` (optional): shall be a scalar variable of type default -`logical`. It is an intent(out) argument. It is a logical flag where +`present`: shall be a scalar variable of type `logical`. +It is an intent(out) argument. It is a logical flag where `.true.` indicates that an entry with that `key` is present in the `map` and `.false.` indicates that no such entry is present. @@ -1529,6 +1428,7 @@ number of slots in the hash map. {!example/hashmaps/example_hashmaps_loading.f90!} ``` + #### `map_entry` - inserts an entry into the hash map ##### Status @@ -1543,7 +1443,6 @@ Inserts an entry into the hash map if it is not already present. `call map % ` [[hashmap_type(type):map_entry(bound)]] `( key[, other, conflict ] )` - ##### Class Subroutine @@ -1559,9 +1458,9 @@ entry. or `int32` array. It is an `intent(in)` argument. It is the key for the entry to be placed in the table. -`other` (optional): shall be a scalar expression of type `other_type`. - It is an `intent(in)` argument. If present it is the other data to be - associated with the `key`. +`other` (optional): shall be a scalar of any type, including derived types. +It is an `intent(in)` argument. If present it is the value to be +associated with the `key`. `conflict` (optional): shall be a scalar variable of type `logical`. It is an `intent(out)` argument. If present, a `.true.` @@ -1570,8 +1469,9 @@ and the entry was not entered into the map, a `.false.` value indicates that `key` was not present in the map and the entry was added to the map. -* If `key` is already present in `map` then the presence of `other` -is ignored. +* If `key` is already present in `map` and the `conflict` argument has been +provided then the presence of `other` is ignored. If `conflict` has not +been provided then it routine will error stop. ##### Example @@ -1579,6 +1479,7 @@ is ignored. {!example/hashmaps/example_hashmaps_map_entry.f90!} ``` + #### `map_probes` - returns the number of hash map probes ##### Status @@ -1618,6 +1519,7 @@ rehashing. {!example/hashmaps/example_hashmaps_probes.f90!} ``` + #### `num_slots` - returns the number of hash map slots. ##### Status @@ -1691,6 +1593,7 @@ It is the hash method to be used by `map`. {!example/hashmaps/example_hashmaps_rehash.f90!} ``` + #### `remove` - removes an entry from the hash map ##### Status @@ -1732,6 +1635,7 @@ absent, the procedure returns with no entry with the given key. {!example/hashmaps/example_hashmaps_remove.f90!} ``` + #### `set_other_data` - replaces the other data for an entry ##### Status @@ -1762,16 +1666,18 @@ and access the entry's data. or `int32` array. It is an `intent(in)` argument. It is the `key` to the entry whose `other` data is to be replaced. -`other`: shall be a scalar expression of type `other_type`. -It is an `intent(in)` argument. It is the data to be stored as -the other data for the entry with the key value, `key`. +`other` (optional): shall be a scalar of any type, including derived types. +It is an `intent(in)` argument. If present it is the value to be +associated with the `key`. -`exists` (optional): shall be a scalar variable of type default -logical. It is an `intent(out)` argument. If present with the value +`exists` (optional): shall be a scalar variable of type `logical`. +It is an `intent(out)` argument. If present with the value `.true.` an entry with that `key` existed in the map and its `other` -data was replaced, otherwise if `exists` is `.false.` the entry did +data was replaced. If `exists` is `.false.` the `key` did not exist and nothing was done. +* If `key` is not already present in `map` and `exists` has not +been provided then the routine will error stop if. ##### Example @@ -1779,6 +1685,7 @@ not exist and nothing was done. {!example/hashmaps/example_hashmaps_set_other_data.f90!} ``` + #### `slots_bits` - returns the number of bits used to address the hash map slots ##### Status From 16d2d344eac127c1d9df9dd99dd1ba869bf34c7b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 9 Jul 2024 22:37:37 -0400 Subject: [PATCH 16/47] Update to remove other_type references Update to remove remaining references to the 'other_type' derived type. --- example/hashmaps/CMakeLists.txt | 4 +- .../hashmaps/example_hashmaps_copy_other.f90 | 25 ------ .../hashmaps/example_hashmaps_free_other.f90 | 21 ----- .../example_hashmaps_get_all_keys.f90 | 2 +- .../example_hashmaps_get_other_data.f90 | 2 +- .../example_hashmaps_set_other_data.f90 | 14 ++-- src/stdlib_hashmap_wrappers.f90 | 81 +------------------ src/stdlib_hashmaps.f90 | 2 - 8 files changed, 17 insertions(+), 134 deletions(-) delete mode 100644 example/hashmaps/example_hashmaps_copy_other.f90 delete mode 100644 example/hashmaps/example_hashmaps_free_other.f90 diff --git a/example/hashmaps/CMakeLists.txt b/example/hashmaps/CMakeLists.txt index fa97acd0a..0d5666fd6 100644 --- a/example/hashmaps/CMakeLists.txt +++ b/example/hashmaps/CMakeLists.txt @@ -1,12 +1,10 @@ ADD_EXAMPLE(hashmaps_calls) ADD_EXAMPLE(hashmaps_copy_key) -ADD_EXAMPLE(hashmaps_copy_other) ADD_EXAMPLE(hashmaps_entries) ADD_EXAMPLE(hashmaps_equal_keys) ADD_EXAMPLE(hashmaps_fnv_1a_hasher) ADD_EXAMPLE(hashmaps_fnv_1_hasher) ADD_EXAMPLE(hashmaps_free_key) -ADD_EXAMPLE(hashmaps_free_other) ADD_EXAMPLE(hashmaps_get) ADD_EXAMPLE(hashmaps_get_all_keys) ADD_EXAMPLE(hashmaps_get_other_data) @@ -26,3 +24,5 @@ ADD_EXAMPLE(hashmaps_set) ADD_EXAMPLE(hashmaps_set_other_data) ADD_EXAMPLE(hashmaps_slots_bits) ADD_EXAMPLE(hashmaps_total_depth) + + diff --git a/example/hashmaps/example_hashmaps_copy_other.f90 b/example/hashmaps/example_hashmaps_copy_other.f90 deleted file mode 100644 index b97d273c8..000000000 --- a/example/hashmaps/example_hashmaps_copy_other.f90 +++ /dev/null @@ -1,25 +0,0 @@ -!! This example left for reference, however 'other_type' has largely -!! been depreciated in the stdlib hashmaps. - -program example_copy_other - use stdlib_hashmap_wrappers, only: & - copy_other, other_type - use iso_fortran_env, only: int8 - implicit none - type(other_type) :: other_in, other_out - integer(int8) :: i - type dummy_type - integer(int8) :: value(15) - end type - type(dummy_type) :: dummy_val - do i = 1, 15 - dummy_val%value(i) = i - end do - allocate (other_in%value, source=dummy_val) - call copy_other(other_in, other_out) - select type (out => other_out%value) - type is (dummy_type) - print *, "other_in == other_out = ", & - all(dummy_val%value == out%value) - end select -end program example_copy_other diff --git a/example/hashmaps/example_hashmaps_free_other.f90 b/example/hashmaps/example_hashmaps_free_other.f90 deleted file mode 100644 index 3910f346b..000000000 --- a/example/hashmaps/example_hashmaps_free_other.f90 +++ /dev/null @@ -1,21 +0,0 @@ -!! This example left for reference, however 'other_type' has largely -!! been depreciated in stdlib hashmaps. - -program example_free_other - use stdlib_hashmap_wrappers, only: & - copy_other, free_other, other_type - use iso_fortran_env, only: int8 - implicit none - type dummy_type - integer(int8) :: value(15) - end type dummy_type - type(dummy_type) :: dummy_val - type(other_type) :: other_in, other_out - integer(int8) :: i - do i = 1, 15 - dummy_val%value(i) = i - end do - allocate (other_in%value, source=dummy_val) - call copy_other(other_in, other_out) - call free_other(other_out) -end program example_free_other diff --git a/example/hashmaps/example_hashmaps_get_all_keys.f90 b/example/hashmaps/example_hashmaps_get_all_keys.f90 index 591c61476..f101c3808 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -2,7 +2,7 @@ program example_hashmaps_get_all_keys use stdlib_kinds, only: int32 use stdlib_hashmaps, only: chaining_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher, get, & - key_type, other_type, set + key_type, set implicit none type(chaining_hashmap_type) :: map type(key_type) :: key diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index 0ca984e36..b91a767ea 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -1,7 +1,7 @@ program example_get_other_data use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type, int_index - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set, get + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set, get implicit none logical :: conflict type(key_type) :: key diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index f90feee8d..bdc673ab0 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -1,24 +1,28 @@ program example_set_other_data use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type, chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher + use stdlib_hashmap_wrappers, only: key_type, set, fnv_1_hasher + implicit none logical :: exists type(chaining_hashmap_type) :: map class(*), allocatable :: data + + type(key_type) :: key ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - call map%map_entry([5, 7, 4, 13], 'A value') + call set(key, [5, 7, 4, 13]) + + call map%map_entry(key, 'A value') - call map%set_other_data([5, 7, 4, 13], 'Another value', exists) + call map%set_other_data(key, 'Another value', exists) print *, 'The entry to have its other data replaced exists = ', exists - call map%get_other_data( [5, 7, 4, 13], data, exists) + call map%get_other_data(key, data, exists) print *, 'Get_other_data was successful = ', exists diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 0991d9ac3..bedf414dc 100644 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -24,12 +24,10 @@ module stdlib_hashmap_wrappers !! Public procedures public :: & copy_key, & - copy_other, & fibonacci_hash, & fnv_1_hasher, & fnv_1a_hasher, & free_key, & - free_other, & get, & hasher_fun, & operator(==), & @@ -40,8 +38,7 @@ module stdlib_hashmap_wrappers !! Public types public :: & - key_type, & - other_type + key_type !! Public integers public :: & @@ -76,20 +73,12 @@ pure function hasher_fun( key ) result(hash_value) end function hasher_fun end interface - type :: other_type -!! Version: Experimental -!! -!! A wrapper type for the other data's true type -! private - class(*), allocatable :: value - end type other_type - + interface get module procedure get_char_key, & get_int8_key, & - get_int32_key, & - get_other + get_int32_key end interface get @@ -102,8 +91,7 @@ end function hasher_fun module procedure set_char_key, & set_int8_key, & - set_int32_key, & - set_other + set_int32_key end interface set @@ -127,23 +115,6 @@ pure subroutine copy_key( old_key, new_key ) end subroutine copy_key - subroutine copy_other( other_in, other_out ) -!! Version: Experimental -!! -!! Copies the other data, other_in, to the variable, other_out -!! ([Specifications](../page/specs/stdlib_hashmaps.html#copy_other-returns-a-copy-of-the-other-data)) -!! -!! Arguments: -!! other_in - the input data -!! other_out - the output data - type(other_type), intent(in) :: other_in - type(other_type), intent(out) :: other_out - - allocate(other_out % value, source = other_in % value ) - - end subroutine copy_other - - function equal_keys( key1, key2 ) result(test) ! Chase's tester !! Version: Experimental !! @@ -187,21 +158,6 @@ subroutine free_key( key ) end subroutine free_key - subroutine free_other( other ) -!! Version: Experimental -!! -!! Frees the memory in the other data -!! ([Specifications](../page/specs/stdlib_hashmaps.html#free_other-frees-the-memory-associated-with-other-data)) -!! -!! Arguments: -!! other - the other data - type(other_type), intent(inout) :: other - - if ( allocated( other % value) ) deallocate( other % value ) - - end subroutine free_other - - subroutine get_char_key( key, value ) !! Version: Experimental !! @@ -249,20 +205,6 @@ subroutine get_char_key( key, value ) end subroutine get_char_key - subroutine get_other( other, value ) -!! Version: Experimental -!! -!! Gets the contents of the other as a CLASS(*) string -!! Arguments: -!! other - the input other data -!! value - the contents of other mapped to a CLASS(*) variable - type(other_type), intent(in) :: other - class(*), allocatable, intent(out) :: value - - allocate(value, source=other % value) - - end subroutine get_other - subroutine get_int8_key( key, value ) !! Version: Experimental @@ -310,21 +252,6 @@ subroutine set_char_key( key, value ) end subroutine set_char_key - subroutine set_other( other, value ) -!! Version: Experimental -!! -!! Sets the contents of the other data from a CLASS(*) variable -!! Arguments: -!! other - the output other data -!! value - the input CLASS(*) variable - type(other_type), intent(out) :: other - class(*), intent(in) :: value - - allocate(other % value, source=value) - - end subroutine set_other - - subroutine set_int8_key( key, value ) !! Version: Experimental !! diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index b96bd8a59..5bc310c32 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -18,12 +18,10 @@ module stdlib_hashmaps use stdlib_hashmap_wrappers, only: & copy_key, & - copy_other, & fibonacci_hash, & fnv_1_hasher, & fnv_1a_hasher, & free_key, & - free_other, & get, & hasher_fun, & operator(==), & From 8ade03dbc53074ad80ea361f0d5180c115bdc3a9 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 9 Jul 2024 22:46:57 -0400 Subject: [PATCH 17/47] Update example_hashmaps_map_entry.f90 Remove reference to other_type --- example/hashmaps/example_hashmaps_map_entry.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_map_entry.f90 b/example/hashmaps/example_hashmaps_map_entry.f90 index dc76d88ea..e8cd3b061 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -1,7 +1,7 @@ program example_map_entry use, intrinsic:: iso_fortran_env, only: int8, int64 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set implicit none type(chaining_hashmap_type) :: map type(key_type) :: key From 793c049e8caf259dc0a4428f8457a7381a86b043 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 9 Jul 2024 22:57:42 -0400 Subject: [PATCH 18/47] Update example_hashmaps_rehash.f90 Remove 'other_type' reference. --- example/hashmaps/example_hashmaps_rehash.f90 | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/example/hashmaps/example_hashmaps_rehash.f90 b/example/hashmaps/example_hashmaps_rehash.f90 index 2205ca370..fa2d2bb4b 100644 --- a/example/hashmaps/example_hashmaps_rehash.f90 +++ b/example/hashmaps/example_hashmaps_rehash.f90 @@ -2,16 +2,12 @@ program example_rehash use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher, & - key_type, other_type, set + key_type, set implicit none type(open_hashmap_type) :: map type(key_type) :: key - type(other_type) :: other - class(*), allocatable :: dummy - allocate (dummy, source='a dummy value') call map%init(fnv_1_hasher, slots_bits=10) call set(key, [5_int8, 7_int8, 4_int8, 13_int8]) - call set(other, dummy) - call map%map_entry(key, other) + call map%map_entry(key, 'A value') call map%rehash(fnv_1a_hasher) end program example_rehash From 25a11469ad614615e9e51bd87577398a60afe88a Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 9 Jul 2024 23:15:37 -0400 Subject: [PATCH 19/47] Update example_hashmaps_remove.f90 Remove reference to 'other_type'. --- example/hashmaps/example_hashmaps_remove.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 105757a56..26eaf4432 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -2,7 +2,7 @@ program example_remove use stdlib_kinds, only: int8, int64 use stdlib_hashmaps, only: open_hashmap_type, int_index use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, other_type, set + fnv_1a_hasher, key_type, set implicit none type(open_hashmap_type) :: map type(key_type) :: key From 775be76fd6ca5eb2f20eac25bfb4d614b7843f8d Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 10 Jul 2024 08:41:30 -0400 Subject: [PATCH 20/47] Test allocate again Try allocate(new_ent % other, source = other) one more time. --- src/stdlib_hashmap_chaining.f90 | 3 ++- src/stdlib_hashmap_open.f90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a0f5cbeb4..841fb2329 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,7 +569,8 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - if ( present(other) ) new_ent % other = other + !if ( present(other) ) new_ent % other = other + if ( present(other) ) allocate(new_ent % other, source = other) if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index b5355179f..ca8235107 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -554,7 +554,8 @@ module subroutine map_open_entry(map, key, other, conflict) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) if ( present( other ) ) & - new_ent % other = other + !new_ent % other = other + allocate(new_ent % other, source = other) inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap From 154579ec204b88cea4c1bb0813744b77bb892457 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 10 Jul 2024 09:02:04 -0400 Subject: [PATCH 21/47] Update to include allocate statement Another try --- src/stdlib_hashmap_chaining.f90 | 5 ++++- src/stdlib_hashmap_open.f90 | 4 +++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 841fb2329..a25d4c336 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -570,7 +570,10 @@ module subroutine map_chain_entry(map, key, other, conflict) map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) !if ( present(other) ) new_ent % other = other - if ( present(other) ) allocate(new_ent % other, source = other) + if ( present(other) ) then + if ALLOCATED(new_ent % other) deallocate(new_ent % other) + allocate(new_ent % other, source = other) + endif if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index ca8235107..205888df9 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -553,9 +553,11 @@ module subroutine map_open_entry(map, key, other, conflict) call allocate_open_map_entry(map, new_ent) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) - if ( present( other ) ) & + if ( present( other ) ) then !new_ent % other = other + if ALLOCATED(new_ent % other) deallocate(new_ent % other) allocate(new_ent % other, source = other) + endif inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap From d32406bd039719ca5a90efb75492d33dad051037 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 10 Jul 2024 09:10:42 -0400 Subject: [PATCH 22/47] Typo fix typo fix --- src/stdlib_hashmap_chaining.f90 | 2 +- src/stdlib_hashmap_open.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a25d4c336..6757b215b 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -571,7 +571,7 @@ module subroutine map_chain_entry(map, key, other, conflict) call copy_key( key, new_ent % key ) !if ( present(other) ) new_ent % other = other if ( present(other) ) then - if ALLOCATED(new_ent % other) deallocate(new_ent % other) + if ( allocated(new_ent % other) ) deallocate(new_ent % other) allocate(new_ent % other, source = other) endif if ( new_ent % inmap == 0 ) then diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index 205888df9..f358d3883 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -555,7 +555,7 @@ module subroutine map_open_entry(map, key, other, conflict) call copy_key( key, new_ent % key ) if ( present( other ) ) then !new_ent % other = other - if ALLOCATED(new_ent % other) deallocate(new_ent % other) + if ( allocated(new_ent % other) ) deallocate(new_ent % other) allocate(new_ent % other, source = other) endif inmap = new_ent % inmap From b73e0fc08ddf74d33a7f3c7cf85fec78b70a7930 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:50:34 -0400 Subject: [PATCH 23/47] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index c796654be..69bce74eb 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -117,7 +117,7 @@ value, `int32`. ### The `stdlib_hashmap_wrappers`' module's derived types The `stdlib_hashmap_wrappers` defines `key_type` which is intended to -be used for the search keys of hash tables. The tye is opaque. +be used for the search keys of hash tables. The tye is opaque. The current representation is as follows ```fortran From 244b3087315a0430bbdbe21e9052b3f9a770bf5b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:50:55 -0400 Subject: [PATCH 24/47] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 1 - 1 file changed, 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 69bce74eb..323a2ca2d 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -322,7 +322,6 @@ expected to be minor compared to its faster hashing rate. {!example/hashmaps/example_hashmaps_fnv_1a_hasher.f90!} ``` - #### `free_key` - frees the memory associated with a key ##### Status From 6c73db726ed6df78336dc2e4a31b93aa73116ba6 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:51:13 -0400 Subject: [PATCH 25/47] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 323a2ca2d..4ec195949 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1469,7 +1469,7 @@ that `key` was not present in the map and the entry was added to the map. * If `key` is already present in `map` and the `conflict` argument has been -provided then the presence of `other` is ignored. If `conflict` has not +provided then the presence of `other` is ignored. If `conflict` has not been provided then it routine will error stop. ##### Example From 054f71245d1558544816ff5f493f98330e5c8a2f Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:51:23 -0400 Subject: [PATCH 26/47] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 4ec195949..259503836 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1676,7 +1676,7 @@ data was replaced. If `exists` is `.false.` the `key` did not exist and nothing was done. * If `key` is not already present in `map` and `exists` has not -been provided then the routine will error stop if. +been provided then the routine will error stop. ##### Example From 057fcac85ac6c44e35cc5cfa4005347ff39f5c8d Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:51:30 -0400 Subject: [PATCH 27/47] Update example/hashmaps/CMakeLists.txt Co-authored-by: Jeremie Vandenplas --- example/hashmaps/CMakeLists.txt | 2 -- 1 file changed, 2 deletions(-) diff --git a/example/hashmaps/CMakeLists.txt b/example/hashmaps/CMakeLists.txt index 0d5666fd6..83133adfd 100644 --- a/example/hashmaps/CMakeLists.txt +++ b/example/hashmaps/CMakeLists.txt @@ -24,5 +24,3 @@ ADD_EXAMPLE(hashmaps_set) ADD_EXAMPLE(hashmaps_set_other_data) ADD_EXAMPLE(hashmaps_slots_bits) ADD_EXAMPLE(hashmaps_total_depth) - - From c3e4d317deb13ac21646ef02885f77c9f9a37873 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:52:10 -0400 Subject: [PATCH 28/47] Update example/hashmaps/example_hashmaps_get_other_data.f90 Co-authored-by: Jeremie Vandenplas --- example/hashmaps/example_hashmaps_get_other_data.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_get_other_data.f90 b/example/hashmaps/example_hashmaps_get_other_data.f90 index b91a767ea..32815e189 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -5,7 +5,6 @@ program example_get_other_data implicit none logical :: conflict type(key_type) :: key - type(chaining_hashmap_type) :: map type dummy_type integer :: value(4) From facd189593820b4a8619132fa409fbd95414a923 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:52:17 -0400 Subject: [PATCH 29/47] Update example/hashmaps/example_hashmaps_map_entry.f90 Co-authored-by: Jeremie Vandenplas --- example/hashmaps/example_hashmaps_map_entry.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_map_entry.f90 b/example/hashmaps/example_hashmaps_map_entry.f90 index e8cd3b061..78d499d17 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -14,7 +14,6 @@ program example_map_entry type(array_data_wrapper) :: array_example - ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) From 2b2c29078d8f99107fd04c2e4942703720010e8e Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:52:31 -0400 Subject: [PATCH 30/47] Update example/hashmaps/example_hashmaps_remove.f90 Co-authored-by: Jeremie Vandenplas --- example/hashmaps/example_hashmaps_remove.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 26eaf4432..b3c5699f8 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -12,7 +12,6 @@ program example_remove ! Initialize hashmap with 2^10 slots. ! Hashmap will dynamically increase size if needed. call map%init(fnv_1_hasher, slots_bits=10) - ! Explicitly set key type using set function call set(key, [1, 2, 3]) call map%map_entry(key, 4.0) From 0e29642a3693bbfc6b5da3a7bee59e9ed90aee75 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:52:39 -0400 Subject: [PATCH 31/47] Update example/hashmaps/example_hashmaps_set_other_data.f90 Co-authored-by: Jeremie Vandenplas --- example/hashmaps/example_hashmaps_set_other_data.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/example/hashmaps/example_hashmaps_set_other_data.f90 b/example/hashmaps/example_hashmaps_set_other_data.f90 index bdc673ab0..7b9f217d7 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -7,7 +7,6 @@ program example_set_other_data logical :: exists type(chaining_hashmap_type) :: map class(*), allocatable :: data - type(key_type) :: key ! Initialize hashmap with 2^10 slots. From 3c60ba47a6007f57fe19b84868ab58c8242d276f Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 08:59:14 -0400 Subject: [PATCH 32/47] Reverting back to in-line allocation Reverting back to inline allocation based on PR discussion. Both approaches seemed to work fine. --- src/stdlib_hashmap_chaining.f90 | 6 +----- src/stdlib_hashmap_open.f90 | 6 +----- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 6757b215b..a0f5cbeb4 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,11 +569,7 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - !if ( present(other) ) new_ent % other = other - if ( present(other) ) then - if ( allocated(new_ent % other) ) deallocate(new_ent % other) - allocate(new_ent % other, source = other) - endif + if ( present(other) ) new_ent % other = other if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index f358d3883..cd53bd85e 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -553,11 +553,7 @@ module subroutine map_open_entry(map, key, other, conflict) call allocate_open_map_entry(map, new_ent) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) - if ( present( other ) ) then - !new_ent % other = other - if ( allocated(new_ent % other) ) deallocate(new_ent % other) - allocate(new_ent % other, source = other) - endif + if ( present( other ) ) new_ent % other = other inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap From 7118fc535078ce36418711486c54fc51fc1a409f Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 10:16:12 -0400 Subject: [PATCH 33/47] Revert "Reverting back to in-line allocation" This reverts commit 3c60ba47a6007f57fe19b84868ab58c8242d276f. --- src/stdlib_hashmap_chaining.f90 | 6 +++++- src/stdlib_hashmap_open.f90 | 6 +++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a0f5cbeb4..6757b215b 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,7 +569,11 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - if ( present(other) ) new_ent % other = other + !if ( present(other) ) new_ent % other = other + if ( present(other) ) then + if ( allocated(new_ent % other) ) deallocate(new_ent % other) + allocate(new_ent % other, source = other) + endif if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index cd53bd85e..f358d3883 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -553,7 +553,11 @@ module subroutine map_open_entry(map, key, other, conflict) call allocate_open_map_entry(map, new_ent) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) - if ( present( other ) ) new_ent % other = other + if ( present( other ) ) then + !new_ent % other = other + if ( allocated(new_ent % other) ) deallocate(new_ent % other) + allocate(new_ent % other, source = other) + endif inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap From 624a7c84f605b3f11ead709f461da61328d49aab Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 21:18:34 -0400 Subject: [PATCH 34/47] Reapply "Reverting back to in-line allocation" This reverts commit 7118fc535078ce36418711486c54fc51fc1a409f. --- src/stdlib_hashmap_chaining.f90 | 6 +----- src/stdlib_hashmap_open.f90 | 6 +----- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 6757b215b..a0f5cbeb4 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,11 +569,7 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - !if ( present(other) ) new_ent % other = other - if ( present(other) ) then - if ( allocated(new_ent % other) ) deallocate(new_ent % other) - allocate(new_ent % other, source = other) - endif + if ( present(other) ) new_ent % other = other if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index f358d3883..cd53bd85e 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -553,11 +553,7 @@ module subroutine map_open_entry(map, key, other, conflict) call allocate_open_map_entry(map, new_ent) new_ent % hash_val = hash_val call copy_key( key, new_ent % key ) - if ( present( other ) ) then - !new_ent % other = other - if ( allocated(new_ent % other) ) deallocate(new_ent % other) - allocate(new_ent % other, source = other) - endif + if ( present( other ) ) new_ent % other = other inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap From 0df1d81321e2e599a4e5911ccdf46c01ba169f8a Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 11 Jul 2024 23:08:58 -0400 Subject: [PATCH 35/47] Update stdlib_hashmap_chaining.f90 Remove outdated comment. --- src/stdlib_hashmap_chaining.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a0f5cbeb4..a0e694a10 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -345,7 +345,6 @@ module subroutine get_other_chaining_data( map, key, other, exists ) end if else if ( associated( map % inverse(inmap) % target ) ) then if (present(exists) ) exists = .true. - !allocate(other, source = map % inverse(inmap) % target % other) other = map % inverse(inmap) % target % other else if ( present(exists) ) then From 9415a37bc8c9dbbb1c4e05a798be7c09a3990b59 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 15 Jul 2024 08:58:10 -0400 Subject: [PATCH 36/47] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_hashmaps.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 259503836..99a132574 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1377,7 +1377,7 @@ or `int32` array. It is an `intent(in)` argument. It is a `key` whose presence in the `map` is being examined. `present`: shall be a scalar variable of type `logical`. -It is an intent(out) argument. It is a logical flag where +It is an `intent(out)` argument. It is a logical flag where `.true.` indicates that an entry with that `key` is present in the `map` and `.false.` indicates that no such entry is present. From 351e628d7fdd84074f7eb3466bc687bf3c7cd09b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 15 Jul 2024 22:33:09 -0400 Subject: [PATCH 37/47] Update stdlib_hashmap_chaining.f90 Test to see if removing associate construct fixes the one CI failure. --- src/stdlib_hashmap_chaining.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a0e694a10..3d2e6ba14 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -809,11 +809,12 @@ module subroutine set_other_chaining_data( map, key, other, exists ) invalid_inmap end if else if ( associated( map % inverse(inmap) % target ) ) then - associate( target => map % inverse(inmap) % target ) - target % other = other + ! associate( target => map % inverse(inmap) % target ) + ! target % other = other + map % inverse(inmap) % target % other = other if ( present(exists) ) exists = .true. return - end associate + ! end associate else error stop submodule_name // ' % ' // procedure // ': ' // & invalid_inmap From 3e7337ebfedb55a592cf8ea9a4db7bfdf5d322d2 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 15 Jul 2024 22:49:01 -0400 Subject: [PATCH 38/47] Update stdlib_hashmap_chaining.f90 Another try to fix the CI --- src/stdlib_hashmap_chaining.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 3d2e6ba14..5d028e143 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -811,7 +811,11 @@ module subroutine set_other_chaining_data( map, key, other, exists ) else if ( associated( map % inverse(inmap) % target ) ) then ! associate( target => map % inverse(inmap) % target ) ! target % other = other - map % inverse(inmap) % target % other = other + !map % inverse(inmap) % target % other = other + if allocated( map % inverse(inmap) % target % other ) then + deallocate( map % inverse(inmap) % target % other ) + endif + allocate( map % inverse(inmap) % target % other, source=other) if ( present(exists) ) exists = .true. return ! end associate From 4bd0bb469f09f44eefbae9062c80eafe398b6a27 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 15 Jul 2024 22:56:20 -0400 Subject: [PATCH 39/47] Update stdlib_hashmap_chaining.f90 --- src/stdlib_hashmap_chaining.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 5d028e143..a559ce442 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -812,7 +812,7 @@ module subroutine set_other_chaining_data( map, key, other, exists ) ! associate( target => map % inverse(inmap) % target ) ! target % other = other !map % inverse(inmap) % target % other = other - if allocated( map % inverse(inmap) % target % other ) then + if ( allocated( map % inverse(inmap) % target % other ) ) then deallocate( map % inverse(inmap) % target % other ) endif allocate( map % inverse(inmap) % target % other, source=other) From bf3c90de5058a21061993db181f4c9f095fe015b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 07:59:10 -0400 Subject: [PATCH 40/47] Set_other CI fix Hopefully this fixes the CI failures seen on 32 bit Gfortran. --- src/stdlib_hashmap_chaining.f90 | 6 ++---- src/stdlib_hashmap_open.f90 | 13 ++++++++----- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index a559ce442..658d754f5 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -809,16 +809,14 @@ module subroutine set_other_chaining_data( map, key, other, exists ) invalid_inmap end if else if ( associated( map % inverse(inmap) % target ) ) then - ! associate( target => map % inverse(inmap) % target ) - ! target % other = other - !map % inverse(inmap) % target % other = other + ! Explicit deallocation and allocation used to avoid issue + ! seen with 32 bit version of Gfortran. if ( allocated( map % inverse(inmap) % target % other ) ) then deallocate( map % inverse(inmap) % target % other ) endif allocate( map % inverse(inmap) % target % other, source=other) if ( present(exists) ) exists = .true. return - ! end associate else error stop submodule_name // ' % ' // procedure // ': ' // & invalid_inmap diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index cd53bd85e..93d8ba90f 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -839,11 +839,14 @@ module subroutine set_other_open_data( map, key, other, exists ) invalid_inmap end if else if ( associated( map % inverse(inmap) % target ) ) then - associate( target => map % inverse(inmap) % target ) - target % other = other - if ( present(exists) ) exists = .true. - return - end associate + ! Explicit deallocation and allocation used to avoid issue + ! seen with 32 bit version of Gfortran. + if ( allocated( map % inverse(inmap) % target % other ) ) then + deallocate( map % inverse(inmap) % target % other ) + endif + allocate( map % inverse(inmap) % target % other, source=other) + if ( present(exists) ) exists = .true. + return else error stop submodule_name // ' % ' // procedure // ': ' // & invalid_inmap From 2ae0d6d88ffe71e5140166d665f8d7b3af283005 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 09:58:17 -0400 Subject: [PATCH 41/47] Update set_other again Revert back to inline allocation. --- src/stdlib_hashmap_chaining.f90 | 11 +++-------- src/stdlib_hashmap_open.f90 | 7 +------ 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 658d754f5..897964b53 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -809,14 +809,9 @@ module subroutine set_other_chaining_data( map, key, other, exists ) invalid_inmap end if else if ( associated( map % inverse(inmap) % target ) ) then - ! Explicit deallocation and allocation used to avoid issue - ! seen with 32 bit version of Gfortran. - if ( allocated( map % inverse(inmap) % target % other ) ) then - deallocate( map % inverse(inmap) % target % other ) - endif - allocate( map % inverse(inmap) % target % other, source=other) - if ( present(exists) ) exists = .true. - return + map % inverse(inmap) % target % other = other + if ( present(exists) ) exists = .true. + return else error stop submodule_name // ' % ' // procedure // ': ' // & invalid_inmap diff --git a/src/stdlib_hashmap_open.f90 b/src/stdlib_hashmap_open.f90 index 93d8ba90f..fe569fb1e 100644 --- a/src/stdlib_hashmap_open.f90 +++ b/src/stdlib_hashmap_open.f90 @@ -839,12 +839,7 @@ module subroutine set_other_open_data( map, key, other, exists ) invalid_inmap end if else if ( associated( map % inverse(inmap) % target ) ) then - ! Explicit deallocation and allocation used to avoid issue - ! seen with 32 bit version of Gfortran. - if ( allocated( map % inverse(inmap) % target % other ) ) then - deallocate( map % inverse(inmap) % target % other ) - endif - allocate( map % inverse(inmap) % target % other, source=other) + map % inverse(inmap) % target % other = other if ( present(exists) ) exists = .true. return else From 937cade86f4fb935d016f92ea3c2a238a939f36d Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 22:33:42 -0400 Subject: [PATCH 42/47] Update stdlib_hashmap_chaining.f90 Another try to fix CI issue --- src/stdlib_hashmap_chaining.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 897964b53..47796ec46 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -568,7 +568,8 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - if ( present(other) ) new_ent % other = other + !if ( present(other) ) new_ent % other = other + allocate( new_ent % other, source=other) if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries From 873a6deac5ac0bebe316fba40c1191a1af0fc0d1 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 22:40:05 -0400 Subject: [PATCH 43/47] Update stdlib_hashmap_chaining.f90 --- src/stdlib_hashmap_chaining.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 47796ec46..70a9b4129 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,7 +569,7 @@ module subroutine map_chain_entry(map, key, other, conflict) map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) !if ( present(other) ) new_ent % other = other - allocate( new_ent % other, source=other) + if ( present(other) ) allocate( new_ent % other, source=other) if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries From e6296c84a817d3cdec410b3fcb79eb7e3eaad144 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 22:57:13 -0400 Subject: [PATCH 44/47] Revert "Update stdlib_hashmap_chaining.f90" This reverts commit 873a6deac5ac0bebe316fba40c1191a1af0fc0d1. --- src/stdlib_hashmap_chaining.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 70a9b4129..47796ec46 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -569,7 +569,7 @@ module subroutine map_chain_entry(map, key, other, conflict) map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) !if ( present(other) ) new_ent % other = other - if ( present(other) ) allocate( new_ent % other, source=other) + allocate( new_ent % other, source=other) if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries From f7d35c54bd59e6e3eeba23d8c99ef6a7a758287b Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 16 Jul 2024 22:57:22 -0400 Subject: [PATCH 45/47] Revert "Update stdlib_hashmap_chaining.f90" This reverts commit 937cade86f4fb935d016f92ea3c2a238a939f36d. --- src/stdlib_hashmap_chaining.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 47796ec46..897964b53 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -568,8 +568,7 @@ module subroutine map_chain_entry(map, key, other, conflict) new_ent % next => map % slots(hash_index) % target map % slots(hash_index) % target => new_ent call copy_key( key, new_ent % key ) - !if ( present(other) ) new_ent % other = other - allocate( new_ent % other, source=other) + if ( present(other) ) new_ent % other = other if ( new_ent % inmap == 0 ) then map % num_entries = map % num_entries + 1 inmap = map % num_entries From 188a74cd560258908bf80f5483eeb9a8a020f45f Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Fri, 30 Aug 2024 21:57:22 -0400 Subject: [PATCH 46/47] Update stdlib_hashmaps.f90 --- src/stdlib_hashmaps.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 5bc310c32..8b11ea937 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -441,7 +441,7 @@ module subroutine init_chaining_map( map, & slots_bits, & status ) !! Version: Experimental -!! +!! !! Routine to allocate an empty map with HASHER as the hash function, !! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited !! to a maximum of 2**MAX_BITS. All fields are initialized. From fbce81fd21f69457106d45f4291401a800f7d679 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 3 Sep 2024 22:33:21 -0400 Subject: [PATCH 47/47] Revert "Update stdlib_hashmaps.f90" This reverts commit 188a74cd560258908bf80f5483eeb9a8a020f45f. --- src/stdlib_hashmaps.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_hashmaps.f90 b/src/stdlib_hashmaps.f90 index 8b11ea937..5bc310c32 100644 --- a/src/stdlib_hashmaps.f90 +++ b/src/stdlib_hashmaps.f90 @@ -441,7 +441,7 @@ module subroutine init_chaining_map( map, & slots_bits, & status ) !! Version: Experimental -!! +!! !! Routine to allocate an empty map with HASHER as the hash function, !! 2**SLOTS_BITS initial SIZE(map % slots), and SIZE(map % slots) limited !! to a maximum of 2**MAX_BITS. All fields are initialized.