From 834d07bba8037da5dfa83d4fe1270a1bcc58538d Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 7 Apr 2024 21:42:22 +0200 Subject: [PATCH 1/3] Addition of a test for the procedure remove for chaining maps --- test/hashmaps/test_maps.fypp | 100 +++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp index 8e8311c96..a7e62d9e9 100644 --- a/test/hashmaps/test_maps.fypp +++ b/test/hashmaps/test_maps.fypp @@ -41,6 +41,7 @@ contains , new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & #:endfor #:endfor + , new_unittest("chaining-maps-removal-spec", test_removal_spec) & ] end subroutine collect_stdlib_chaining_maps @@ -173,6 +174,55 @@ contains end subroutine + subroutine test_removal_spec(error) + !! Test following code provided by @jannisteunissen + !! https://github.com/fortran-lang/stdlib/issues/785 + type(error_type), allocatable, intent(out) :: error + + type(chaining_hashmap_type) :: map + type(key_type) :: key + integer, parameter :: n_max = 500 + integer :: n + integer, allocatable :: key_counts(:) + integer, allocatable :: seed(:) + integer(int8) :: int32_int8(4) + integer(int32) :: keys(n_max) + real(dp) :: r_uniform(n_max) + logical :: existed, present + + call random_seed(size = n) + allocate(seed(n), source = 123456) + call random_seed(put = seed) + + call random_number(r_uniform) + keys = nint(r_uniform * n_max * 0.25_dp) + + call map%init(fnv_1_hasher, slots_bits=10) + + do n = 1, n_max + call set(key, transfer(keys(n), int32_int8)) + call map%key_test(key, present) + if (present) then + call map%remove(key, existed) + call check(error, existed, "chaining-removal-spec: Key not found in entry removal.") + else + call map%map_entry(key) + end if + end do + + ! Count number of keys that occur an odd number of times + allocate(key_counts(minval(keys):maxval(keys)), source = 0) + do n = 1, n_max + key_counts(keys(n)) = key_counts(keys(n)) + 1 + end do + n = sum(iand(key_counts, 1)) + + call check(error, map%entries(), n, & + "chaining-removal-spec: Number of expected keys and entries are different.") + return + + end subroutine + end module module test_stdlib_open_maps @@ -215,6 +265,7 @@ contains , new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & #:endfor #:endfor + , new_unittest("open-maps-removal-spec", test_removal_spec) & ] end subroutine collect_stdlib_open_maps @@ -347,6 +398,55 @@ contains end subroutine + subroutine test_removal_spec(error) + !! Test following code provided by @jannisteunissen + !! https://github.com/fortran-lang/stdlib/issues/785 + type(error_type), allocatable, intent(out) :: error + + type(open_hashmap_type) :: map + type(key_type) :: key + integer, parameter :: n_max = 500 + integer :: n + integer, allocatable :: key_counts(:) + integer, allocatable :: seed(:) + integer(int8) :: int32_int8(4) + integer(int32) :: keys(n_max) + real(dp) :: r_uniform(n_max) + logical :: existed, present + + call random_seed(size = n) + allocate(seed(n), source = 123456) + call random_seed(put = seed) + + call random_number(r_uniform) + keys = nint(r_uniform * n_max * 0.25_dp) + + call map%init(fnv_1_hasher, slots_bits=10) + + do n = 1, n_max + call set(key, transfer(keys(n), int32_int8)) + call map%key_test(key, present) + if (present) then + call map%remove(key, existed) + call check(error, existed, "open-removal-spec: Key not found in entry removal.") + else + call map%map_entry(key) + end if + end do + + ! Count number of keys that occur an odd number of times + allocate(key_counts(minval(keys):maxval(keys)), source = 0) + do n = 1, n_max + key_counts(keys(n)) = key_counts(keys(n)) + 1 + end do + n = sum(iand(key_counts, 1)) + + call check(error, map%entries(), n, & + "open-removal-spec: Number of expected keys and entries are different.") + return + + end subroutine + end module From a4c579dc4948c4775adf81061a1b9dae6ff2800e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sun, 7 Apr 2024 21:42:48 +0200 Subject: [PATCH 2/3] Fix for the procedure remove in chaining maps --- src/stdlib_hashmap_chaining.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/stdlib_hashmap_chaining.f90 b/src/stdlib_hashmap_chaining.f90 index 273545680..b121f90a9 100644 --- a/src/stdlib_hashmap_chaining.f90 +++ b/src/stdlib_hashmap_chaining.f90 @@ -775,6 +775,7 @@ module subroutine remove_chaining_entry(map, key, existed) centry % next => bentry map % inverse(inmap) % target => null() map % num_free = map % num_free + 1 + map % num_entries = map % num_entries - 1 end subroutine remove_chaining_entry From 35387c844799c06a1ce23e8c76d290a0ca1d9a70 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Mon, 8 Apr 2024 12:38:08 +0200 Subject: [PATCH 3/3] test_maps.fypp: addition of return statement after checks --- test/hashmaps/test_maps.fypp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp index a7e62d9e9..835bb9369 100644 --- a/test/hashmaps/test_maps.fypp +++ b/test/hashmaps/test_maps.fypp @@ -205,6 +205,7 @@ contains if (present) then call map%remove(key, existed) call check(error, existed, "chaining-removal-spec: Key not found in entry removal.") + return else call map%map_entry(key) end if @@ -429,6 +430,7 @@ contains if (present) then call map%remove(key, existed) call check(error, existed, "open-removal-spec: Key not found in entry removal.") + return else call map%map_entry(key) end if