diff --git a/doc/specs/stdlib_hashmaps.md b/doc/specs/stdlib_hashmaps.md index 94b42413f..99a132574 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,7 +316,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 @@ -412,36 +352,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 +361,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 +377,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 +431,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 +472,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 +516,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 +572,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 +616,6 @@ As a result it should give reasonable performance for typical hash table applications. This code passes the SMHasher tests. - ##### Example ```fortran @@ -728,17 +631,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 +646,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 +799,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 +809,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 +896,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 +904,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 +918,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 +981,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 +994,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 +1015,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 +1062,7 @@ as follows: end type open_hashmap_type ``` + ### Table of `stdlib_hashmap` procedures The `stdlib_hashmap` module provides procedures in @@ -1185,21 +1084,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 +1244,7 @@ Experimental ##### Description -Returns the other data associated with the `key`, +Returns the value associated with the `key`, ##### Syntax @@ -1365,9 +1264,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 +1278,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 +1376,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 +1427,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 +1442,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 +1457,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 +1468,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 +1478,7 @@ is ignored. {!example/hashmaps/example_hashmaps_map_entry.f90!} ``` + #### `map_probes` - returns the number of hash map probes ##### Status @@ -1618,6 +1518,7 @@ rehashing. {!example/hashmaps/example_hashmaps_probes.f90!} ``` + #### `num_slots` - returns the number of hash map slots. ##### Status @@ -1691,6 +1592,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 +1634,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 +1665,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. ##### Example @@ -1779,6 +1684,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 diff --git a/example/hashmaps/CMakeLists.txt b/example/hashmaps/CMakeLists.txt index fa97acd0a..83133adfd 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) diff --git a/example/hashmaps/example_hashmaps_copy_other.f90 b/example/hashmaps/example_hashmaps_copy_other.f90 deleted file mode 100644 index a9d9c03e1..000000000 --- a/example/hashmaps/example_hashmaps_copy_other.f90 +++ /dev/null @@ -1,22 +0,0 @@ -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 6f4a0f292..000000000 --- a/example/hashmaps/example_hashmaps_free_other.f90 +++ /dev/null @@ -1,18 +0,0 @@ -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 2a91cd1ab..f101c3808 100644 --- a/example/hashmaps/example_hashmaps_get_all_keys.f90 +++ b/example/hashmaps/example_hashmaps_get_all_keys.f90 @@ -2,11 +2,10 @@ 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 - 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 3c6c82d29..32815e189 100644 --- a/example/hashmaps/example_hashmaps_get_other_data.f90 +++ b/example/hashmaps/example_hashmaps_get_other_data.f90 @@ -1,11 +1,10 @@ program example_get_other_data use stdlib_kinds, only: int8, int64 - use stdlib_hashmaps, only: chaining_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, other_type, set, get + use stdlib_hashmaps, only: chaining_hashmap_type, int_index + use stdlib_hashmap_wrappers, only: fnv_1_hasher, key_type, set, get 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 +20,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 +41,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 +55,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 +72,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 +88,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..78d499d17 100644 --- a/example/hashmaps/example_hashmaps_map_entry.f90 +++ b/example/hashmaps/example_hashmaps_map_entry.f90 @@ -1,43 +1,53 @@ 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 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_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 diff --git a/example/hashmaps/example_hashmaps_remove.f90 b/example/hashmaps/example_hashmaps_remove.f90 index 4ee3dd9ef..602e9d9ad 100644 --- a/example/hashmaps/example_hashmaps_remove.f90 +++ b/example/hashmaps/example_hashmaps_remove.f90 @@ -2,45 +2,40 @@ program example_remove use stdlib_kinds, only: int8, int64 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, key_type, set 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 0b7910874..7b9f217d7 100644 --- a/example/hashmaps/example_hashmaps_set_other_data.f90 +++ b/example/hashmaps/example_hashmaps_set_other_data.f90 @@ -1,22 +1,37 @@ program example_set_other_data - use stdlib_hashmaps, only: open_hashmap_type - use stdlib_hashmap_wrappers, only: fnv_1_hasher, & - fnv_1a_hasher, key_type, other_type, set + use stdlib_kinds, only: int8 + use stdlib_hashmaps, only: open_hashmap_type, chaining_hashmap_type + use stdlib_hashmap_wrappers, only: key_type, set, fnv_1_hasher + implicit none logical :: exists - type(open_hashmap_type) :: map - type(key_type) :: key - type(other_type) :: other + 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 set(key, [5, 7, 4, 13]) - call set(other, 'A value') - call map%map_entry(key, other) - call set(other, 'Another value') - call map%set_other_data(key, other, exists) + call map%map_entry(key, 'A value') + + 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(key, 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. + 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..897964b53 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 @@ -810,11 +809,9 @@ 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 ) - call copy_other( other, target % other ) - if ( present(exists) ) exists = .true. - return - end associate + 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 b271f9869..fe569fb1e 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 @@ -553,8 +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 ) ) & - call copy_other( other, new_ent % other ) + if ( present( other ) ) new_ent % other = other inmap = new_ent % inmap map % inverse( inmap ) % target => new_ent map % slots( test_slot ) = inmap @@ -822,7 +821,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 @@ -840,11 +839,9 @@ 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 ) - call copy_other( other, target % other ) - if ( present(exists) ) exists = .true. - return - end associate + 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_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 d7da35dea..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(==), & @@ -32,7 +30,6 @@ module stdlib_hashmaps seeded_water_hasher, & set, & key_type, & - other_type, & int_hash implicit none @@ -131,7 +128,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 @@ -181,10 +178,10 @@ 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 - type(other_type), intent(out) :: other + class(*), allocatable, intent(out) :: other logical, intent(out), optional :: exists end subroutine key_get_other_data @@ -254,10 +251,10 @@ 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 - type(other_type), intent(in), optional :: other + class(*), intent(in), optional :: other logical, intent(out), optional :: conflict end subroutine key_map_entry @@ -302,10 +299,10 @@ 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 - type(other_type), intent(in) :: other + class(*), intent(in) :: other logical, intent(out), optional :: exists end subroutine key_set_other_data @@ -319,7 +316,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 +333,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 +431,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 +500,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 +547,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 +577,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 +681,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 +751,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 +796,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 +825,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 +844,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 +863,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 +951,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 +971,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 +991,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 +1091,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 +1117,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 +1143,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..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 @@ -218,14 +213,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..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 @@ -219,14 +217,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