Skip to content
Merged
Show file tree
Hide file tree
Changes from 3 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
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,6 @@ buildlib.csm_sharec
# Ignore emacs backup files
*~

# Typical directory used for unit test build
/unit_tests.temp/

103 changes: 102 additions & 1 deletion src/shr_string_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ module shr_string_mod
public :: shr_string_listGetIndex ! Get index of field
public :: shr_string_listGetIndexF ! function version of listGetIndex
public :: shr_string_listGetName ! get k-th field name
public :: shr_string_listGetAllNames ! get all field names
public :: shr_string_listIntersect ! get intersection of two field lists
public :: shr_string_listUnion ! get union of two field lists
public :: shr_string_listDiff ! get set difference of two field lists
Expand Down Expand Up @@ -954,7 +955,7 @@ subroutine shr_string_listGetName(list,k,name,rc)
!EOP

!----- local -----
integer(SHR_KIND_IN) :: i,n ! generic indecies
integer(SHR_KIND_IN) :: i,n ! generic indices
integer(SHR_KIND_IN) :: kFlds ! number of fields in list
integer(SHR_KIND_IN) :: i0,i1 ! name = list(i0:i1)
integer(SHR_KIND_IN) :: rCode ! return code
Expand Down Expand Up @@ -1011,6 +1012,106 @@ subroutine shr_string_listGetName(list,k,name,rc)

end subroutine shr_string_listGetName

!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: shr_string_listGetAllNames -- Get names of all fields in list
!
! !DESCRIPTION:
! Get names of all fields in list
! \newline
! Allocates the output array
! \newline
! call shr\_string\_listGetAllNames(list,names,rc)
!
! !REVISION HISTORY:
! 2025-Nov-10 - W. Sacks
!
! !INTERFACE: ------------------------------------------------------------------

subroutine shr_string_listGetAllNames(list,names,rc)

! !INPUT/OUTPUT PARAMETERS:

character(*) ,intent(in) :: list ! list/string
character(*), allocatable ,intent(out) :: names(:) ! k-th name in list
integer(SHR_KIND_IN),optional,intent(out) :: rc ! return code

!EOP

!----- local -----
integer(SHR_KIND_IN) :: num_fields ! number of fields in list
integer(SHR_KIND_IN) :: n ! current field number
integer(SHR_KIND_IN) :: num_chars ! number of characters in this field
integer(SHR_KIND_IN) :: i0,i1 ! name = list(i0:i1)
integer(SHR_KIND_IN) :: rCode ! return code
integer(SHR_KIND_IN) :: t01 = 0 ! timer

!----- formats -----
character(*),parameter :: subName = "(shr_string_listGetAllNames) "
character(*),parameter :: F00 = "('(shr_string_listGetAllNames) ',4a)"

!-------------------------------------------------------------------------------
! Notes:
!-------------------------------------------------------------------------------

if (debug>1 .and. t01<1) call shr_timer_get(t01,subName)
if (debug>1) call shr_timer_start(t01)

rCode = 0

!--- check that this is a valid list ---
if (.not. shr_string_listIsValid(list,rCode) ) then
write(s_logunit,F00) "ERROR: invalid list = ",trim(list)
call shr_string_abort(subName//" ERROR: invalid list = "//trim(list))
end if

num_fields = shr_string_listGetNum(list)

allocate(names(num_fields))
i0 = 1
do n = 1, num_fields
! Invariant at this point: i0 is the index of the first character of field n

if (n < num_fields) then
! Find index of last character of field n
num_chars = index(list(i0:), listDel) - 1

if (num_chars < 1) then
! This implies that either listDel wasn't found (in which case index will
! return 0) or that listDel is the next character (in which case index will
! return 1). Neither of these should happen: the first case implies an
! inconsistency with shr_string_listGetNum, and the second case should have
! been caught by shr_string_listIsValid. Nevertheless, we check for these
! possibilities here so that we can issue a meaningful error message if an
! issue somehow slipped through the cracks.
call shr_string_abort(subName//" ERROR: internal inconsistency processing list = "//trim(list))
end if

if (num_chars > len(names)) then
call shr_string_abort(subName//" ERROR: an element of list <"//trim(list)// &
"> exceeds the max char length of the output variable")
end if

i1 = i0 + num_chars - 1
else
! Special case: the last field ends at the end of the string
i1 = len_trim(list)
end if

! Store this field
names(n) = list(i0:i1)

! The next field starts two characters after the end of the current field (skipping
! the delimiter).
i0 = i1 + 2
end do

if (present(rc)) rc = rCode
if (debug>1) call shr_timer_stop (t01)

end subroutine shr_string_listGetAllNames

!===============================================================================
!BOP ===========================================================================
!
Expand Down
187 changes: 187 additions & 0 deletions test/unit/shr_string_test/test_shr_string.pf
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,193 @@ module test_shr_string

contains

! ------------------------------------------------------------------------
! Tests of shr_string_listIsValid
! ------------------------------------------------------------------------

@Test
subroutine test_shr_string_listIsValid_emptyList()
! An empty list should be considered invalid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = ""
is_valid = shr_string_listIsValid(list, rc)
@assertFalse(is_valid)
@assertNotEqual(rc, 0)
end subroutine test_shr_string_listIsValid_emptyList

@Test
subroutine test_shr_string_listIsValid_firstCharDelimiter()
! An list where the first character is a delimiter should be considered invalid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = ":ab:cd"
is_valid = shr_string_listIsValid(list, rc)
@assertFalse(is_valid)
@assertNotEqual(rc, 0)
end subroutine test_shr_string_listIsValid_firstCharDelimiter

@Test
subroutine test_shr_string_listIsValid_lastCharDelimiter()
! An list where the last character is a delimiter should be considered invalid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab:cd:"
is_valid = shr_string_listIsValid(list, rc)
@assertFalse(is_valid)
@assertNotEqual(rc, 0)
end subroutine test_shr_string_listIsValid_lastCharDelimiter

@Test
subroutine test_shr_string_listIsValid_whitespace()
! An list where there is whitespace in the middle of a field name should be
! considered invalid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab:c d:ef"
is_valid = shr_string_listIsValid(list, rc)
@assertFalse(is_valid)
@assertNotEqual(rc, 0)
end subroutine test_shr_string_listIsValid_whitespace

@Test
subroutine test_shr_string_listIsValid_zeroLengthField()
! An list with a zero-length field should be considered invalid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab::ef"
is_valid = shr_string_listIsValid(list, rc)
@assertFalse(is_valid)
@assertNotEqual(rc, 0)
end subroutine test_shr_string_listIsValid_zeroLengthField

@Test
subroutine test_shr_string_listIsValid_oneField()
! An list with a single field should be considered valid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab"
is_valid = shr_string_listIsValid(list, rc)
@assertTrue(is_valid)
@assertEqual(rc, 0)
end subroutine test_shr_string_listIsValid_oneField

@Test
subroutine test_shr_string_listIsValid_twoFields()
! An list with two fields should be considered valid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab:cd"
is_valid = shr_string_listIsValid(list, rc)
@assertTrue(is_valid)
@assertEqual(rc, 0)
end subroutine test_shr_string_listIsValid_twoFields

@Test
subroutine test_shr_string_listIsValid_threeFields()
! An list with three fields should be considered valid
character(len=32) :: list
logical :: is_valid
integer :: rc

list = "ab:cd:ef"
is_valid = shr_string_listIsValid(list, rc)
@assertTrue(is_valid)
@assertEqual(rc, 0)
end subroutine test_shr_string_listIsValid_threeFields

! ------------------------------------------------------------------------
! Tests of shr_string_listGetAllNames
! ------------------------------------------------------------------------

@Test
subroutine test_shr_string_listGetAllNames_length1strlen1()
! Test shr_string_listGetAllNames with a single-element list, with string length 1
character(len=32) :: list
character(len=4), allocatable :: names(:)
integer :: rc
character(len=4), parameter :: expected_names(1) = ["x "]

list = "x"
call shr_string_listGetAllNames(list, names, rc)
@assertEqual(0, rc)
@assertEqual(1, size(names))
@assertEqual(expected_names, names)
end subroutine test_shr_string_listGetAllNames_length1strlen1

@Test
subroutine test_shr_string_listGetAllNames_length1strlen3()
! Test shr_string_listGetAllNames with a single-element list, with string length 3
character(len=32) :: list
character(len=4), allocatable :: names(:)
integer :: rc
character(len=4), parameter :: expected_names(1) = ["xyz "]

list = "xyz"
call shr_string_listGetAllNames(list, names, rc)
@assertEqual(0, rc)
@assertEqual(1, size(names))
@assertEqual(expected_names, names)
end subroutine test_shr_string_listGetAllNames_length1strlen3

@Test
subroutine test_shr_string_listGetAllNames_length5strlen1()
! Test shr_string_listGetAllNames with a 5-element list, with string length 1
character(len=32) :: list
character(len=4), allocatable :: names(:)
integer :: rc
character(len=4), parameter :: expected_names(5) = ["a ", "b ", "c ", "d ", "e "]

list = "a:b:c:d:e"
call shr_string_listGetAllNames(list, names, rc)
@assertEqual(0, rc)
@assertEqual(5, size(names))
@assertEqual(expected_names, names)
end subroutine test_shr_string_listGetAllNames_length5strlen1

@Test
subroutine test_shr_string_listGetAllNames_length5strlenVaries()
! Test shr_string_listGetAllNames with a 5-element list, with varying string length
character(len=32) :: list
character(len=4), allocatable :: names(:)
integer :: rc
! Note that one of the names here hits the max strlen of names (4), which tests to
! make sure we don't inappropriately abort for that max length.
character(len=4), parameter :: expected_names(5) = ["abc ", "defg", "hi ", "j ", "klm "]

list = "abc:defg:hi:j:klm"
call shr_string_listGetAllNames(list, names, rc)
@assertEqual(0, rc)
@assertEqual(5, size(names))
@assertEqual(expected_names, names)
end subroutine test_shr_string_listGetAllNames_length5strlenVaries

@Test
subroutine test_shr_string_listGetAllNames_tooLong()
! Test shr_string_listGetAllNames with a too-long element
character(len=32) :: list
character(len=4), allocatable :: names(:)
integer :: rc

list = "abc:defgh:ijk"
call shr_string_listGetAllNames(list, names, rc)
@assertExceptionRaised("ABORTED: (shr_string_listGetAllNames) ERROR: an element of list <abc:defgh:ijk> exceeds the max char length of the output variable")
end subroutine test_shr_string_listGetAllNames_tooLong

! ------------------------------------------------------------------------
! Tests of shr_string_leftAlign_and_convert_tabs
! ------------------------------------------------------------------------
Expand Down