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
29 changes: 21 additions & 8 deletions src/sourcery/sourcery_string_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,17 @@ module sourcery_string_m
generic :: string => as_character
procedure :: is_allocated
procedure :: get_json_key
generic :: operator(/=) => string_t_ne_string_t, string_t_ne_character, character_ne_string_t
generic :: operator(==) => string_t_eq_string_t, string_t_eq_character, character_eq_string_t
generic :: get_json_value => &
get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
procedure, private :: &
get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
procedure, private :: string_t_ne_string_t, string_t_ne_character
generic :: operator(/=) => string_t_ne_string_t, string_t_ne_character, character_ne_string_t
generic :: operator(==) => string_t_eq_string_t, string_t_eq_character, character_eq_string_t
generic :: assignment(= ) => assign_string_t_to_character, assign_character_to_string_t
generic :: get_json_value => get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
procedure, private :: get_json_integer_array, get_json_logical, get_json_integer, get_json_string, get_json_real
procedure, private :: string_t_ne_string_t, string_t_ne_character
procedure, private :: string_t_eq_string_t, string_t_eq_character
procedure, private :: assign_character_to_string_t
procedure, private, pass(rhs) :: character_ne_string_t
procedure, private :: string_t_eq_string_t, string_t_eq_character
procedure, private, pass(rhs) :: character_eq_string_t
procedure, private, pass(rhs) :: assign_string_t_to_character
end type

interface string_t
Expand Down Expand Up @@ -136,6 +137,18 @@ elemental module function character_ne_string_t(lhs, rhs) result(lhs_ne_rhs)
logical lhs_ne_rhs
end function

pure module subroutine assign_character_to_string_t(lhs, rhs)
implicit none
class(string_t), intent(inout) :: lhs
character(len=*), intent(in) :: rhs
end subroutine

pure module subroutine assign_string_t_to_character(lhs, rhs)
implicit none
class(string_t), intent(in) :: rhs
character(len=:), intent(out), allocatable :: lhs
end subroutine

end interface

end module sourcery_string_m
8 changes: 8 additions & 0 deletions src/sourcery/sourcery_string_s.f90
Original file line number Diff line number Diff line change
Expand Up @@ -179,4 +179,12 @@
lhs_ne_rhs = lhs /= rhs%string()
end procedure

module procedure assign_string_t_to_character
lhs = rhs%string()
end procedure

module procedure assign_character_to_string_t
lhs%string_ = rhs
end procedure

end submodule sourcery_string_s
22 changes: 21 additions & 1 deletion test/string_test.f90
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,9 @@ function results() result(test_results)
test_result_t("extracting an integer array value from a colon-separated key/value pair", extracts_integer_array_value()), &
test_result_t("extracting an integer value from a colon-separated key/value pair", extracts_integer_value()), &
test_result_t('supporting operator(==) for string_t and character operands', supports_equivalence_operator()), &
test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()) &
test_result_t('supporting operator(/=) for string_t and character operands', supports_non_equivalence_operator()), &
test_result_t('assigning a string_t object to a character variable', assigns_string_t_to_character()), &
test_result_t('assigning a character variable to a string_t object', assigns_character_to_string_t()) &
]
end function

Expand Down Expand Up @@ -121,4 +123,22 @@ function supports_non_equivalence_operator() result(passed)
"123.456" /= string_t("456.123")
end function

function assigns_string_t_to_character() result(passed)
logical passed
character(len=:), allocatable :: lhs

associate(rhs => string_t("ya don't say"))
lhs = rhs
passed = lhs == rhs
end associate
end function

function assigns_character_to_string_t() result(passed)
logical passed
character(len=*), parameter :: rhs = "well, alrighty then"
type(string_t) lhs
lhs = rhs
passed = lhs == rhs
end function

end module string_test_m