From 91bbc176b6255c0fa18733f36486888826f71e8e Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 21 Jun 2022 10:54:02 +0200 Subject: [PATCH 1/5] fix some issues --- doc/specs/stdlib_hashmaps.md | 63 ++++++++++++++++++--------------- src/stdlib_hashmap_wrappers.f90 | 3 +- 2 files changed, 36 insertions(+), 30 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index abe6b92c8..d34a6471c 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -21,7 +21,7 @@ This document discusses the hash maps in the Fortran Standard Library. The Fortran Standard Library is distributed under the MIT License. However components of the library should be evaluated as to whether -they are compatible with the MTI License. +they are compatible with the MIT License. The current hash maps were inspired by an [implementation](http://chasewoerner.org/src/hasht/) of David Chase. While the code has been greatly modified from his @@ -229,14 +229,14 @@ is an `intent(out)` argument. ```fortran program demo_copy_key use stdlib_hashmap_wrappers, only: & - copy_key, operator(==), key_type + copy_key, operator(==), key_type, set use iso_fortran_env, only: int8 implicit none integer(int8) :: i, value(15) type(key_type) :: old_key, new_key value = [(i, i = 1, 15)] - call set( key_out, value ) - call copy_key( key_out, new_key ) + call set( old_key, value ) + call copy_key( old_key, new_key ) print *, "old_key == new_key = ", old_key == new_key end program demo_copy_key ``` @@ -276,7 +276,7 @@ is an `intent(out)` argument. use iso_fortran_env, only: int8 implicit none type(other_type) :: other_in, other_out - integer(int_8) :: i + integer(int8) :: i class(*), allocatable :: dummy type dummy_type integer(int8) :: value(15) @@ -287,8 +287,8 @@ is an `intent(out)` argument. end do allocate(other_in % value, source=dummy_val) call copy_other( other_in, other_out ) - select type(other_out) - type(dummy_type) + select type(other_out) !there is an issue here, please check. + typeis(dummy_type) print *, "other_in == other_out = ", & all( dummy_val % value == other_out % value ) end select @@ -507,19 +507,19 @@ is an `intent(out)` argument. ```fortran program demo_free_other use stdlib_hashmap_wrappers, only: & - copy_other, free_other, other_type, set + 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 - typer(dummy_type) :: dummy_val + type(dummy_type) :: dummy_val type(other_type), allocatable :: other_in, other_out - integer(int_8) :: i + integer(int8) :: i do i=1, 15 dummy_val % value(i) = i end do - allocate(other_in, source=dummy_val) + allocate(other_in % value, source=dummy_val) call copy_other( other_in, other_out ) call free_other( other_out ) end program demo_free_other @@ -573,7 +573,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument. implicit none integer(int8), allocatable :: value(:), result(:) type(key_type) :: key - integer(int_8) :: i + integer(int8) :: i allocate( value(1:15) ) do i=1, 15 value(i) = i @@ -585,7 +585,7 @@ an allocatable of `class(*)`. It is an `intent(out)` argument. ``` -#### `hasher_fun`- serves aa a function prototype. +#### `hasher_fun`- serves as a function prototype. ##### Status @@ -933,7 +933,7 @@ value to an `int8` vector. implicit none integer(int8), allocatable :: value(:), result(:) type(key_type) :: key - integer(int_8) :: i + integer(int8) :: i allocate( value(1:15) ) do i=1, 15 value(i) = i @@ -1392,7 +1392,7 @@ The result will be the number of procedure calls on the hash map. use stdlib_hashmap_wrappers, only: fnv_1_hasher implicit none type(chaining_hashmap_type) :: map - type(int_calls) :: initial_calls + integer(int_calls) :: initial_calls call map % init( fnv_1_hasher ) initial_calls = map % calls() print *, "INITIAL_CALLS = ", initial_calls @@ -1518,9 +1518,9 @@ undefined. end if call get( other, data ) select type( data ) - type (dummy_type) + typeis (dummy_type) print *, 'Other data % value = ', data % value - type default + class default print *, 'Invalid data type in other' end select end program demo_get_other_data @@ -1587,11 +1587,11 @@ has the value `alloc_fault`. ```fortran program demo_init - use stdlib_hashmaps, only: chaining_map_type + use stdlib_hashmaps, only: chaining_hashmap_type use stdlib_hashmap_wrappers, only: fnv_1_hasher - type(fnv_1a_type) :: fnv_1 - type(chaining_map_type) :: map - call map % init( fnv_1a, slots_bits=10 ) + implicit none + type(chaining_hashmap_type) :: map + call map % init( fnv_1_hasher, slots_bits=10 ) end program demo_init ``` @@ -1748,7 +1748,7 @@ is ignored. program demo_map_entry use, intrinsic:: iso_fortran_env, only: int8 use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set type(chaining_hashmap_type) :: map type(key_type) :: key logical :: conflict @@ -1806,7 +1806,7 @@ rehashing. type(chaining_hashmap_type) :: map real :: nprobes call map % init( fnv_1_hasher ) - nprobes = map % probes() + nprobes = map % map_probes() print *, "Initial probes = ", nprobes end program demo_probes ``` @@ -1855,7 +1855,7 @@ The result is the number of slots in `map`. call map % init( fnv_1_hasher ) initial_slots = map % num_slots () print *, "Initial slots = ", initial_slots - end program num_slots + end program demo_num_slots ``` @@ -1891,10 +1891,12 @@ It is the hash method to be used by `map`. ```fortran program demo_rehash + use stdlib_kinds, only: int8 use stdlib_hashmaps, only: open_hashmap_type - use stdlib_hasmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,& - key_type, other_type - type(openn_hashmap_type) :: map + use stdlib_hashmap_wrappers, only: fnv_1_hasher, fnv_1a_hasher,& + key_type, other_type, set + implicit none + type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other class(*), allocatable :: dummy @@ -2009,20 +2011,23 @@ not exist and nothing was done. ```fortran program demo_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 + implicit none + logical :: exists type(open_hashmap_type) :: map type(key_type) :: key type(other_type) :: other class(*), allocatable :: dummy call map % init( fnv_1_hasher, slots_bits=10 ) - allocate( dummy, source='A value` ) + allocate( dummy, source='A value' ) call set( key, [ 5_int8, 7_int8, 4_int8, 13_int8 ] ) call set( other, dummy ) call map % map_entry( key, other ) deallocate( dummy ) - allocate( dummy, source='Another value` ) + allocate( dummy, source='Another value' ) call set( other, dummy ) call map % set_other_data( key, other, exists ) print *, 'The entry to have its other data replaced exists = ', exists diff --git a/src/stdlib_hashmap_wrappers.f90 b/src/stdlib_hashmap_wrappers.f90 index 67b13b96e..a2a8b93d2 100755 --- a/src/stdlib_hashmap_wrappers.f90 +++ b/src/stdlib_hashmap_wrappers.f90 @@ -87,7 +87,8 @@ end function hasher_fun interface get module procedure get_char_key, & - get_int8_key + get_int8_key, & + get_other end interface get From 0c003edc245ae271ea0cfb43c00301671e0fc9f6 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 21 Jun 2022 12:07:19 +0200 Subject: [PATCH 2/5] small changed stdlib_io.md --- doc/specs/stdlib_io.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 971a8ee29..6fb30a97d 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -178,7 +178,7 @@ program demo_loadnpy use stdlib_io_npy, only: load_npy implicit none real, allocatable :: x(:,:) - call loadtxt('example.npy', x) + call load_npy('example.npy', x) end program demo_loadnpy ``` @@ -293,8 +293,8 @@ Provides formats for all kinds as defined in the `stdlib_kinds` module. ```fortran program demo_fmt_constants - use, stdlib_kinds, only : int32, int64, sp, dp - use stdlib_io, only : FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_COMPLEX_SP, FMT_COMPLEX_DP + use stdlib_kinds, only : int32, int64, sp, dp + use stdlib_io, only : FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_COMPLEX_SP, FMT_COMPLEX_DP implicit none integer(kind=int32) :: i32 From 38bece61edd0f78a2cff6859608e3ae0a3c8a670 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 21 Jun 2022 19:44:00 +0200 Subject: [PATCH 3/5] fix name --- 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 d34a6471c..d5a940503 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1565,7 +1565,7 @@ Subroutine error code. * If `slots_bits` is absent then the effective value for `slots_bits` - is `default_slots_bits`. + is `default_bits`. `status` (optional): shall be a scalar integer variable of kind `int32`. It is an `intent(out)` argument. On return if present it From c81d06e9bc8457c11dbd18fc996ff8d1a7baaeab Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Wed, 22 Jun 2022 15:57:13 +0200 Subject: [PATCH 4/5] fix issue in demo_copy_other --- doc/specs/stdlib_hashmaps.md | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index d5a940503..a618803f6 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -271,26 +271,24 @@ is an `intent(out)` argument. ```fortran program demo_copy_other - use stdlib_hashmap_wrappers, only: & - copy_other, get, other_type, set + 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 - class(*), allocatable :: dummy type dummy_type integer(int8) :: value(15) end type type(dummy_type) :: dummy_val - do i=1, 15 + do i = 1, 15 dummy_val % value1(i) = i end do allocate(other_in % value, source=dummy_val) call copy_other( other_in, other_out ) - select type(other_out) !there is an issue here, please check. - typeis(dummy_type) + select type(out => other_out % value) + type is (dummy_type) print *, "other_in == other_out = ", & - all( dummy_val % value == other_out % value ) + all( dummy_val % value == out % value ) end select end program demo_copy_other ``` From 09c507c1965e0f6dac0d3f76581bdfcfe3f1e686 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 5 Jul 2022 02:23:23 -0400 Subject: [PATCH 5/5] Update doc/specs/stdlib_hashmaps.md Co-authored-by: Ian Giestas Pauli --- 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 a618803f6..b0b56ed15 100644 --- a/doc/specs/stdlib_hashmaps.md +++ b/doc/specs/stdlib_hashmaps.md @@ -1516,7 +1516,7 @@ undefined. end if call get( other, data ) select type( data ) - typeis (dummy_type) + type is (dummy_type) print *, 'Other data % value = ', data % value class default print *, 'Invalid data type in other'