Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
60 changes: 60 additions & 0 deletions DataStructures/Tests/dictionary_test.f90
Original file line number Diff line number Diff line change
Expand Up @@ -549,4 +549,64 @@ subroutine testGetSize(this)
end subroutine testGetSize


@test
subroutine testAddressOfNodes(this)
class(test_dictionary), intent(inout) :: this
type(dictionary) :: workDict, workDict2
type(dictionary), pointer :: dictPtr => null()
character(nameLen) :: keyword
character(:), allocatable :: tempString
integer(shortInt) :: i

dictPtr => this % dict % getDictPtr('nestedDict')

! ! Verify node address following normal construction
@assertEqual("/", this % dict % address)
@assertEqual("/nestedDict/", dictPtr % address)

! We need to verify a case when we copy dictionary out
! all dictionaries nested deeper must have their address updated correctly
! Add more nesting
call workDict % init(1)
call workDict % store("anInt", 1)

call workDict2 % init(1)
call workDict2 % store("aReal", 1.0_defReal)

call workDict % store("subsubsubDict", workDict2)

call dictPtr % store("subsubDict", workDict)
call workDict % kill()
call workDict2 % kill()

! Verify that after storing address is correct

! Nested dictionary
dictPtr => this % dict % getDictPtr("nestedDict")
dictPtr => dictPtr % getDictPtr("subsubDict")
tempString = dictPtr % address
@assertEqual("/nestedDict/subsubDict/", tempString)

! Double nested dictionary
dictPtr => dictPtr % getDictPtr("subsubsubDict")
tempString = dictPtr % address
@assertEqual("/nestedDict/subsubDict/subsubsubDict/", tempString)

! Copy out a dictionary
call this % dict % get(workDict, "nestedDict")

@assertEqual("/", workDict % address)

! Nested dictionary
dictPtr => workDict % getDictPtr("subsubDict")
tempString = dictPtr % address
@assertEqual("/subsubDict/", tempString)

! Double nested dictionary
dictPtr => dictPtr % getDictPtr("subsubsubDict")
tempString = dictPtr % address
@assertEqual("/subsubDict/subsubsubDict/", tempString)

end subroutine testAddressOfNodes

end module dictionary_test
128 changes: 106 additions & 22 deletions DataStructures/dictionary_class.f90
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,10 @@ module dictionary_class
character(nameLen),dimension(:),allocatable :: keywords
type(dictContent),dimension(:), allocatable :: entries

! Meta data
! TODO: public is bad! Get a getter!
character(:), allocatable, public :: address

! Dictionary state information
integer(shortInt) :: maxSize = 0 ! Maximum size of a dictionary
integer(shortInt) :: dictLen = 0 ! Current size of the dictionary
Expand All @@ -137,6 +141,8 @@ module dictionary_class
procedure :: isPresent
procedure :: getSize
procedure :: getDictPtr
procedure :: updateAddress
procedure :: errorMsgPrefix
procedure :: length => length_dictionary

generic :: get => getReal_new,&
Expand Down Expand Up @@ -307,6 +313,9 @@ subroutine init(self,maxSize,stride)
allocate(self % keywords(maxSize))
allocate(self % entries(maxSize))

! Set initial address
self % address = "/"

! Keywords can (perhaps?) allocate with some garbage inside. Make sure all entries are blank.
self % keywords = ''

Expand Down Expand Up @@ -347,6 +356,8 @@ recursive subroutine kill_dictionary(self)

end if

if (allocated(self % address)) deallocate(self % address)

end subroutine kill_dictionary

!!
Expand Down Expand Up @@ -377,7 +388,7 @@ recursive subroutine copy_dictionary(LHS,RHS)
rhsSize = size( RHS % keywords)
stride = RHS % stride

call LHS % init(rhsSize,stride)
call LHS % init(rhsSize, stride)

! Copy Keywords and entries
LHS % keywords = RHS % keywords
Expand All @@ -391,6 +402,9 @@ recursive subroutine copy_dictionary(LHS,RHS)
LHS % maxSize = RHS % maxSize
LHS % stride = RHS % stride

! After a copy we set the current dictionary as a root
call LHS % updateAddress("", "")

end subroutine copy_dictionary

!!
Expand Down Expand Up @@ -420,7 +434,8 @@ function getSize(self, keyword) result(S)

idx = linFind(self % keywords, keyword)
if (idx == targetNotFound) then
call fatalError(Here,'Target: '//trim(keyword)//' is not in dictionary')
call fatalError(Here, self % errorMsgPrefix() // &
"Target: "//trim(keyword)//" is not present")
end if

S = self % entries(idx) % getSize()
Expand Down Expand Up @@ -460,7 +475,8 @@ subroutine getReal_new(self,value,keyword)
value = real(self % entries(idx) % int0_alloc, defReal)

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a real or int')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a real or int')

end select

Expand Down Expand Up @@ -490,7 +506,8 @@ subroutine getRealArray_alloc_new(self,value,keyword)
value = real(self % entries(idx) % int1_alloc, defReal)

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a real array or int array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a real array or int array')

end select

Expand Down Expand Up @@ -525,7 +542,8 @@ subroutine getRealArray_ptr_new(self,value,keyword)
value = real(self % entries(idx) % int1_alloc, defReal)

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a real array or int array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a real array or int array')

end select

Expand All @@ -549,7 +567,8 @@ subroutine getInt_new(self,value,keyword)
value = self % entries(idx) % int0_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not an integer')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not an integer')

end select

Expand All @@ -576,7 +595,8 @@ subroutine getIntArray_alloc_new(self,value,keyword)
value = self % entries(idx) % int1_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not integer array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not integer array')

end select

Expand Down Expand Up @@ -606,7 +626,8 @@ subroutine getIntArray_ptr_new(self,value,keyword)
value = self % entries(idx) % int1_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not integer array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not integer array')

end select

Expand All @@ -628,13 +649,15 @@ subroutine getChar_new(self,value,keyword)
case(word)
! Check if the content character fits into value
if( len(value) < len_trim(self % entries(idx) % char0_alloc)) then
call fatalError(Here,'value character is too short to store content. Increase its length')
call fatalError(Here, self % errorMsgPrefix() // &
'value character is too short to store content. Increase its length')
end if

value = self % entries(idx) % char0_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a character')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a character')

end select

Expand All @@ -660,13 +683,15 @@ subroutine getCharArray_alloc_new(self,value,keyword)
! Check if the content character fits into value. Any is required becouse len_trim returns
! an array
if( any(len(value) < len_trim(self % entries(idx) % char1_alloc))) then
call fatalError(Here,'value character is too short to store content. Increase its length')
call fatalError(Here, self % errorMsgPrefix() // &
'value character is too short to store content. Increase its length')
end if

value = self % entries(idx) % char1_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a character array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a character array')

end select

Expand All @@ -692,15 +717,17 @@ subroutine getCharArray_ptr_new(self,value,keyword)
! Check if the content character fits into value. Any is required becouse len_trim returns
! an array
if( any( len(value) < len_trim(self % entries(idx) % char1_alloc)) ) then
call fatalError(Here,'value character is to short to store content. Increase its length')
call fatalError(Here, self % errorMsgPrefix() // &
'value character is too short to store content. Increase its length')
end if

! Use mold to approperiatly allocate the pointer
allocate(value ( size(self % entries(idx) % char1_alloc) ))
value = self % entries(idx) % char1_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a character array')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a character array')

end select

Expand All @@ -723,7 +750,8 @@ subroutine getDict_new(self,value,keyword)
value = self % entries(idx) % dict0_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a dictionary')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a dictionary')

end select

Expand All @@ -746,12 +774,62 @@ function getDictPtr(self, keyword) result(ptr)
ptr => self % entries(idx) % dict0_alloc

case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not a dictionary')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not a dictionary')

end select

end function getDictPtr

!!
!! Update the address of the dictionary and all dictionaries inside
!!
!! Args:
!! parentAddress [in] -> Address of the dictionary owning the 'self' ("" if self is a root)
!! keyword [in] -> keyword under 'self' is stored ("" if self is a root)
!!
recursive subroutine updateAddress(self, parentAddress, keyword)
class(dictionary), intent(inout) :: self
character(*), intent(in) :: parentAddress
character(*), intent(in) :: keyword
integer(shortInt) :: i

self % address = trim(parentAddress) // trim(keyword) // "/"

!! Propagate to all nested dictionaries
do i=1,self % dictLen
if (self % entries(i) % getType() == nestDict) then
call self % entries(i) % dict0_alloc % updateAddress(self % address, self % keywords(i))
end if
end do

end subroutine updateAddress

!!
!! Returns prefix for error messages with address of the dictionary
!!
function errorMsgPrefix(self) result(msg)
class(dictionary), intent(in) :: self
character(:), allocatable :: msg
integer(shortInt) :: i_end

! Check invalid states
if (.not. allocated(self % address)) then
msg = "In dictionary [NOT ALLOCATED ADDRESS :-/ ] "
return
end if
if (len(self % address) == 0) then
msg = "In dictionary [EMPTY ADDRESS :-/] "
return
end if

! We wish to trim the final '/' from the address
! We assume that things were not corrupted and don't check that final
! character is really a '/'
i_end = len(self % address) - 1
msg = "In dictionary [" // self % address(1:i_end) // "] "

end function errorMsgPrefix

!!
!! Loads a boolean from a dictionary
Expand All @@ -773,10 +851,12 @@ subroutine getBool_new(self,value,keyword)
elseif (i == 0) then
value = .false.
else
call fatalError(Here,'Entry under keyword ' // keyword // ' is neither 0 nor 1')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is neither 0 nor 1')
end if
case default
call fatalError(Here,'Entry under keyword ' // keyword // ' is not an integer')
call fatalError(Here, self % errorMsgPrefix() // 'Entry under keyword ' // &
keyword // ' is not an integer')
end select
end subroutine getBool_new

Expand Down Expand Up @@ -1094,7 +1174,7 @@ subroutine keys(self, keysArr, type)
case('dict')
mask = (self % entries(1:L) % getType() == nestDict)
case default
call fatalError(Here,'Unrecognised type of content type: '//type )
call fatalError(Here, self % errorMsgPrefix() // 'Unrecognised type of content type: '//type )
end select
end if

Expand Down Expand Up @@ -1232,7 +1312,7 @@ end subroutine store_charArray
!!
!! Stores a dictionary rank 0 in dictionary
!!
subroutine store_dict(self,keywordArgument,entry)
subroutine store_dict(self, keywordArgument, entry)
class(dictionary), intent(inout) :: self
character(*), intent(in) :: keywordArgument
class(dictionary), intent(in) :: entry
Expand All @@ -1243,14 +1323,17 @@ subroutine store_dict(self,keywordArgument,entry)

idx = self % getEmptyIdx(keyword)

self % keywords(idx) = keyword
self % keywords(idx) = keyword

! Load into dictionary content
allocate(self % entries(idx) % dict0_alloc)

self % entries(idx) % dict0_alloc = entry
self % entries(idx) % type = nestDict

! Update address of the nested dictionary
call self % entries(idx) % dict0_alloc % updateAddress(self % address, keyword)

end subroutine store_dict

!!
Expand Down Expand Up @@ -1289,7 +1372,8 @@ function search(self, keyword, where, fatal) result(idx)
idx = linFind(self % keywords, keyword)

if(idx == targetNotFound .and. fatal_loc) then
call fatalError(Where,'Keyword: '// trim(keyword) //' was requested but is not in the dictionary')
call fatalError(Where, self % errorMsgPrefix() // &
"Keyword: '" // trim(keyword) // "' was requested but not found.")
end if

end function search
Expand Down