Skip to content

Apply fixes found by Fortitude linter #13

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
peverwhee merged 6 commits into from
Aug 31, 2026
Merged

Apply fixes found by Fortitude linter #13

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
0b9203f
Add missing intents (done by hand).
nusbaume Aug 25, 2026
811d884
Commit fortitude fixes produced by Claude.
nusbaume Aug 25, 2026
c20c218
Resolve final set of easily-fixable fortitude errors.
nusbaume Aug 26, 2026
b27cdf5
Fix build error found by unit tests.
nusbaume Aug 26, 2026
778e4f7
Make additional code mods found during self-review.
nusbaume Aug 26, 2026
d0659ca
Attempt to fix failing unit test.
nusbaume Aug 26, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
68 changes: 42 additions & 26 deletions src/hash/hist_hash_table.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
!!XXgoldyXX: To do, statistics output
module hist_hash_table

use hist_hashable, only: hist_hashable_t
use, intrinsic :: iso_fortran_env, only: output_unit
use hist_hashable, only: hist_hashable_t

implicit none
private
Expand Down Expand Up @@ -96,16 +97,16 @@ module hist_hash_table
integer, parameter :: gen_hash_key_offset = 21467 ! z'000053db'

integer, parameter :: tbl_max_idx = 15
integer, parameter, dimension(0:tbl_max_idx) :: tbl_gen_hash_key = &
(/ 61, 59, 53, 47, 43, 41, 37, 31, 29, 23, 17, 13, 11, 7, 3, 1 /)
integer, parameter :: tbl_gen_hash_key(0:tbl_max_idx) = &
[61, 59, 53, 47, 43, 41, 37, 31, 29, 23, 17, 13, 11, 7, 3, 1]

integer, parameter :: table_factor_size = 8 ! Table size / # entries
integer, parameter :: table_overflow_factor = 4 ! # entries / Overflow size

type :: table_entry_t
! Any table entry contains a key and a value
class(hist_hashable_t), pointer :: entry_value => NULL()
type(table_entry_t), pointer :: next => NULL()
class(hist_hashable_t), pointer :: entry_value => null()
type(table_entry_t), pointer :: next => null()
contains
procedure :: finalize_table_entry
end type table_entry_t
Expand Down Expand Up @@ -133,24 +134,28 @@ module hist_hash_table
private :: have_error ! Has a called routine detected an error?
private :: clear_optstring ! Clear a string, if present

CONTAINS
contains

!#######################################################################

logical function have_error(errmsg)
pure function have_error(errmsg) result(has_error)
! Return .true. iff <errmsg> is present and contains text
character(len=*), optional, intent(in) :: errmsg
logical :: has_error

have_error = present(errmsg)
if (have_error) then
have_error = len_trim(errmsg) > 0
has_error = present(errmsg)
if (has_error) then
has_error = len_trim(errmsg) > 0
end if
end function have_error

!#######################################################################

subroutine clear_optstring(str)
! clear <str> if it is present
!
! Fortitude:
! allow(assumed-size-character-intent)
Comment thread
peverwhee marked this conversation as resolved.
character(len=*), optional, intent(inout) :: str

if (present(str)) then
Expand All @@ -176,9 +181,9 @@ end subroutine finalize_table_entry
subroutine hash_table_initialize_table(this, tbl_size, key_off)
! Initialize this table.
! Dummy arguments
class(hist_hash_table_t) :: this
integer, intent(in) :: tbl_size ! new table size
integer, optional, intent(in) :: key_off ! key offset
class(hist_hash_table_t), intent(inout) :: this
integer, intent(in) :: tbl_size ! new table size
integer, optional, intent(in) :: key_off ! key offset

! Clear this table so it can be initialized
if (allocated(this%primary_table)) then
Expand All @@ -198,7 +203,7 @@ end subroutine hash_table_initialize_table
subroutine hash_table_deallocate_table(this)
! Deallocate the hash table (if present)
! Dummy argument
class(hist_hash_table_t) :: this
class(hist_hash_table_t), intent(inout) :: this

! Local variable
integer :: entry_index
Expand Down Expand Up @@ -228,8 +233,10 @@ integer function hash_table_key_hash(this, string, errmsg) result(hash_key)
!
! Arguments:
!
class(hist_hash_table_t) :: this
class(hist_hash_table_t), intent(in) :: this
character(len=*), intent(in) :: string
! Fortitude:
! allow(assumed-size-character-intent)
character(len=*), optional, intent(out) :: errmsg
character(len=*), parameter :: subname = 'HASH_TABLE_KEY_HASH'
!
Expand Down Expand Up @@ -257,9 +264,14 @@ integer function hash_table_key_hash(this, string, errmsg) result(hash_key)
write(errmsg, '(2a,2(i0,a))') subname, ' ERROR: Key Hash, ', &
hash_key, ' out of bounds, [1, ', this%table_size, ']'
else
write(6, '(2a,2(i0,a))') subname, ' ERROR: Key Hash, ', &
hash_key, ' out of bounds, [1, ', this%table_size, ']'
STOP 1
! This else-block is only used for unit testing. Eventually
! the unit tests should be updated to use 'errmsg', and this
! code block should be removed (along with making 'errmsg'
! required.
write(output_unit, '(2a,2(i0,a))') subname, &
' ERROR: Key Hash, ', hash_key, ' out of bounds, [1, ', &
this%table_size, ']'
stop 1
end if
end if

Expand All @@ -279,8 +291,10 @@ function hash_table_table_value(this, key, errmsg) result(tbl_val)
!
! Arguments:
!
class(hist_hash_table_t) :: this
class(hist_hash_table_t), intent(in) :: this
character(len=*), intent(in) :: key
! Fortitude:
! allow(assumed-size-character-intent)
character(len=*), optional, intent(out) :: errmsg
class(hist_hashable_t), pointer :: tbl_val
!
Expand All @@ -293,7 +307,7 @@ function hash_table_table_value(this, key, errmsg) result(tbl_val)
call clear_optstring(errmsg)
nullify(tbl_val)
hash_key = this%key_hash(key, errmsg=errmsg)
ASSOCIATE(tbl_entry => this%primary_table(hash_key))
associate(tbl_entry => this%primary_table(hash_key))
if (have_error(errmsg)) then
errmsg = trim(errmsg)//', called from '//subname
else if (associated(tbl_entry%entry_value)) then
Expand All @@ -316,7 +330,7 @@ function hash_table_table_value(this, key, errmsg) result(tbl_val)
end do
end if
end if
END ASSOCIATE
end associate

if ((.not. associated(tbl_val)) .and. present(errmsg)) then
if (.not. have_error(errmsg)) then ! Still need to test for empty
Expand All @@ -340,9 +354,11 @@ subroutine hash_table_add_hash_key(this, newval, errmsg)
!-----------------------------------------------------------------------

! Dummy arguments:
class(hist_hash_table_t) :: this
class(hist_hashable_t), target :: newval
character(len=*), optional, intent(out) :: errmsg
class(hist_hash_table_t) , intent(inout) :: this
class(hist_hashable_t), target , intent(in) :: newval
! Fortitude:
! allow(assumed-size-character-intent)
character(len=*), optional, intent(out) :: errmsg
! Local variables
integer :: hash_ind
integer :: ovflw_len
Expand All @@ -363,7 +379,7 @@ subroutine hash_table_add_hash_key(this, newval, errmsg)
"' already in table"
end if
else
ASSOCIATE(tbl_entry => this%primary_table(hash_ind))
associate(tbl_entry => this%primary_table(hash_ind))
if (associated(tbl_entry%entry_value)) then
! We have a collision, make a new entry
allocate(new_entry)
Expand Down Expand Up @@ -391,7 +407,7 @@ subroutine hash_table_add_hash_key(this, newval, errmsg)
else
tbl_entry%entry_value => newval
end if
END ASSOCIATE
end associate
end if
this%num_keys = this%num_keys + 1

Expand Down
32 changes: 17 additions & 15 deletions src/hash/hist_hashable.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,20 +28,21 @@ module hist_hashable

! Abstract interface for key procedure of hist_hashable_t class
abstract interface
function hist_hashable_get_key(hashable)
function hist_hashable_get_key(hashable) result(key)
import :: hist_hashable_t
implicit none
class(hist_hashable_t), intent(in) :: hashable
character(len=:), allocatable :: hist_hashable_get_key
character(len=:), allocatable :: key
end function hist_hashable_get_key
end interface

CONTAINS
contains

!#######################################################################

subroutine new_hashable_char(name_in, new_obj)
character(len=*), intent(in) :: name_in
type(hist_hashable_char_t), pointer :: new_obj
character(len=*), intent(in) :: name_in
type(hist_hashable_char_t), pointer, intent(inout) :: new_obj

if (associated(new_obj)) then
deallocate(new_obj)
Expand All @@ -52,19 +53,19 @@ end subroutine new_hashable_char

!#######################################################################

function hist_hashable_char_get_key(hashable)
function hist_hashable_char_get_key(hashable) result(key)
! Return the hashable char class key (name)
class(hist_hashable_char_t), intent(in) :: hashable
character(len=:), allocatable :: hist_hashable_char_get_key
character(len=:), allocatable :: key

hist_hashable_char_get_key = hashable%name
key = hashable%name
end function hist_hashable_char_get_key

!#######################################################################

subroutine new_hashable_int(val_in, new_obj)
integer, intent(in) :: val_in
type(hist_hashable_int_t), pointer :: new_obj
integer, intent(in) :: val_in
type(hist_hashable_int_t), pointer, intent(inout) :: new_obj

if (associated(new_obj)) then
deallocate(new_obj)
Expand All @@ -75,24 +76,25 @@ end subroutine new_hashable_int

!#######################################################################

function hist_hashable_int_get_key(hashable)
function hist_hashable_int_get_key(hashable) result(key)
! Return the hashable int class key (value ==> string)
class(hist_hashable_int_t), intent(in) :: hashable
character(len=:), allocatable :: hist_hashable_int_get_key
character(len=:), allocatable :: key

character(len=32) :: key_str

write(key_str, '(i0)') hashable%val()
hist_hashable_int_get_key = trim(key_str)
key = trim(key_str)
end function hist_hashable_int_get_key

!#######################################################################

integer function hist_hashable_int_get_val(hashable)
function hist_hashable_int_get_val(hashable) result(val)
! Return the hashable int class value
class(hist_hashable_int_t), intent(in) :: hashable
integer :: val

hist_hashable_int_get_val = hashable%value
val = hashable%value
end function hist_hashable_int_get_val

end module hist_hashable
Loading
Loading