From 45fd15ccacb000a7d7c64dab9b767462b073bcb2 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Sat, 18 Jun 2022 23:15:21 +0200 Subject: [PATCH] Addition of test_maps using test-drive --- src/tests/hashmaps/CMakeLists.txt | 10 + src/tests/hashmaps/test_maps.fypp | 378 ++++++++++++++++++++++++++++++ 2 files changed, 388 insertions(+) create mode 100644 src/tests/hashmaps/test_maps.fypp diff --git a/src/tests/hashmaps/CMakeLists.txt b/src/tests/hashmaps/CMakeLists.txt index 2d88e06af..7831dde7d 100755 --- a/src/tests/hashmaps/CMakeLists.txt +++ b/src/tests/hashmaps/CMakeLists.txt @@ -1,3 +1,13 @@ +### Pre-process: .fpp -> .f90 via Fypp + +# Create a list of the files to be preprocessed +set(fppFiles + test_maps.fypp +) + +fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) + ADDTEST(chaining_maps) ADDTEST(open_maps) +ADDTEST(maps) diff --git a/src/tests/hashmaps/test_maps.fypp b/src/tests/hashmaps/test_maps.fypp new file mode 100644 index 000000000..cd1e3a4ee --- /dev/null +++ b/src/tests/hashmaps/test_maps.fypp @@ -0,0 +1,378 @@ +#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"] +#:set SIZE_NAME = ["16", "256"] +module test_stdlib_chaining_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + use testdrive, only : new_unittest, unittest_type, error_type, check + use :: stdlib_kinds, only : dp, int8, int32 + use stdlib_hashmaps, only : chaining_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + private + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + public :: collect_stdlib_chaining_maps + +contains + + !> Collect all exported unit tests + subroutine collect_stdlib_chaining_maps(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("chaining-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + , new_unittest("chaining-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & + #:endfor + #:endfor + ] + + end subroutine collect_stdlib_chaining_maps + + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + subroutine test_${hash_}$_${size_}$_byte_words(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(chaining_hashmap_type) :: map + integer(int8) :: test_8_bits(test_size) + + call generate_vector(test_8_bits) + + call map % init( ${hash_}$, slots_bits=10 ) + + call test_input_random_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_inquire_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_get_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_removal(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + end subroutine + #:endfor + #:endfor + + + subroutine generate_vector(test_8_bits) + integer(int8), intent(out) :: test_8_bits(test_size) + + integer :: index + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + end subroutine + + subroutine test_input_random_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(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, 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 check(error, .not.conflict, "Unable to map entry because of a key conflict.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_inquire_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + logical :: present + type(key_type) :: key + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + call check(error, present, "KEY not found in map KEY_TEST.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_get_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + call check(error, exists, "Unable to get data because key not found in map.") + end do + + end subroutine + + subroutine test_removal(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(chaining_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + call check(error, existed, "Key not found in entry removal.") + end do + + end subroutine + +end module + +module test_stdlib_open_maps +!! Test various aspects of the runtime system. +!! Running this program may require increasing the stack size to above 48 MBytes +!! or decreasing rand_power to 20 or less + use testdrive, only : new_unittest, unittest_type, error_type, check + use :: stdlib_kinds, only : dp, int8, int32 + use stdlib_hashmaps, only : open_hashmap_type, int_depth, int_index + use stdlib_hashmap_wrappers + + implicit none + private + + type dummy_type + integer(int8), allocatable :: value(:) + end type dummy_type + + integer(int32), parameter :: huge32 = huge(0_int32) + real(dp), parameter :: hugep1 = real(huge32, dp) + 1.0_dp + integer, parameter :: rand_power = 18 + integer, parameter :: rand_size = 2**rand_power + integer, parameter :: test_size = rand_size*4 + integer, parameter :: test_16 = 2**4 + integer, parameter :: test_256 = 2**8 + + public :: collect_stdlib_open_maps + +contains + + !> Collect all exported unit tests + subroutine collect_stdlib_open_maps(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("open-maps-fnv_1_hasher-16-byte-words", test_fnv_1_hasher_16_byte_words) & + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + , new_unittest("open-maps-${hash_}$-${size_}$-byte-words", test_${hash_}$_${size_}$_byte_words) & + #:endfor + #:endfor + ] + + end subroutine collect_stdlib_open_maps + + #:for hash_ in HASH_NAME + #:for size_ in SIZE_NAME + subroutine test_${hash_}$_${size_}$_byte_words(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(open_hashmap_type) :: map + integer(int8) :: test_8_bits(test_size) + + call generate_vector(test_8_bits) + + call map % init( ${hash_}$, slots_bits=10 ) + + call test_input_random_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_inquire_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_get_data(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + call test_removal(error, map, test_8_bits, test_${size_}$) + if (allocated(error)) return + + end subroutine + #:endfor + #:endfor + + + subroutine generate_vector(test_8_bits) + integer(int8), intent(out) :: test_8_bits(test_size) + + integer :: index + real(dp) :: rand2(2) + integer(int32) :: rand_object(rand_size) + + do index=1, rand_size + call random_number(rand2) + if (rand2(1) < 0.5_dp) then + rand_object(index) = ceiling(-rand2(2)*hugep1, int32) - 1 + else + rand_object(index) = floor(rand2(2)*hugep1, int32) + end if + end do + + test_8_bits(:) = transfer( rand_object, 0_int8, test_size ) + + end subroutine + + subroutine test_input_random_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(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, 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 check(error, .not.conflict, "Unable to map entry because of a key conflict.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_inquire_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + logical :: present + type(key_type) :: key + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % key_test( key, present ) + call check(error, present, "KEY not found in map KEY_TEST.") + if (allocated(error)) return + end do + + end subroutine + + subroutine test_get_data(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + integer :: index2 + type(key_type) :: key + type(other_type) :: other + logical :: exists + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % get_other_data( key, other, exists ) + call check(error, exists, "Unable to get data because key not found in map.") + end do + + end subroutine + + subroutine test_removal(error, map, test_8_bits, test_block) + type(error_type), allocatable, intent(out) :: error + type(open_hashmap_type), intent(inout) :: map + integer(int8), intent(in) :: test_8_bits(test_size) + integer(int_index), intent(in) :: test_block + type(key_type) :: key + integer(int_index) :: index2 + logical :: existed + + do index2=1, size(test_8_bits), test_block + call set( key, test_8_bits( index2:index2+test_block-1 ) ) + call map % remove(key, existed) + call check(error, existed, "Key not found in entry removal.") + end do + + end subroutine + +end module + + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_stdlib_open_maps, only : collect_stdlib_open_maps + use test_stdlib_chaining_maps, only : collect_stdlib_chaining_maps + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("stdlib-open-maps", collect_stdlib_open_maps) & + , new_testsuite("stdlib-chaining-maps", collect_stdlib_chaining_maps) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program