Addition of test_maps using test-drive

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)
 

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