diff --git a/example/ascii/example_ascii_reverse.f90 b/example/ascii/example_ascii_reverse.f90 index ef5901851..403e504c9 100644 --- a/example/ascii/example_ascii_reverse.f90 +++ b/example/ascii/example_ascii_reverse.f90 @@ -1,5 +1,5 @@ program example_reverse - use stdlib_ascii, only: reverse + use stdlib_strings, only: reverse implicit none print'(a)', reverse("Hello, World!") ! returns "!dlroW ,olleH" end program example_reverse diff --git a/example/string_type/example_reverse.f90 b/example/string_type/example_reverse.f90 index 3b63eb778..b02215a39 100644 --- a/example/string_type/example_reverse.f90 +++ b/example/string_type/example_reverse.f90 @@ -1,5 +1,5 @@ program example_reverse - use stdlib_string_type + use stdlib_strings implicit none type(string_type) :: string, reverse_string diff --git a/src/stdlib_ascii.fypp b/src/stdlib_ascii.fypp index 5a4ea2811..f9674e43d 100644 --- a/src/stdlib_ascii.fypp +++ b/src/stdlib_ascii.fypp @@ -19,7 +19,7 @@ module stdlib_ascii public :: is_lower, is_upper ! Character conversion functions - public :: to_lower, to_upper, to_title, to_sentence, reverse + public :: to_lower, to_upper, to_title, to_sentence ! All control characters in the ASCII table (see www.asciitable.com). character(len=1), public, parameter :: NUL = achar(int(z'00')) !! Null @@ -96,14 +96,6 @@ module stdlib_ascii module procedure :: to_sentence end interface to_sentence - !> Returns a new character sequence which is reverse of - !> the input charater sequence - !> This method is pure and returns a character sequence - interface reverse - module procedure :: reverse - end interface reverse - - contains !> Checks whether `c` is an ASCII letter (A .. Z, a .. z). @@ -329,20 +321,4 @@ contains end function to_sentence - !> Reverse the character order in the input character variable - !> ([Specification](../page/specs/stdlib_ascii.html#reverse)) - !> - !> Version: experimental - pure function reverse(string) result(reverse_string) - character(len=*), intent(in) :: string - character(len=len(string)) :: reverse_string - integer :: i, n - - n = len(string) - do i = 1, n - reverse_string(n-i+1:n-i+1) = string(i:i) - end do - - end function reverse - end module stdlib_ascii diff --git a/src/stdlib_string_type.fypp b/src/stdlib_string_type.fypp index 6ca4e1363..10945f117 100644 --- a/src/stdlib_string_type.fypp +++ b/src/stdlib_string_type.fypp @@ -14,7 +14,7 @@ !> The specification of this module is available [here](../page/specs/stdlib_string_type.html). module stdlib_string_type use stdlib_ascii, only: to_lower_ => to_lower, to_upper_ => to_upper, & - & to_title_ => to_title, to_sentence_ => to_sentence, reverse_ => reverse + & to_title_ => to_title, to_sentence_ => to_sentence use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool use stdlib_optval, only: optval implicit none @@ -23,7 +23,7 @@ module stdlib_string_type public :: string_type public :: len, len_trim, trim, index, scan, verify, repeat, adjustr, adjustl public :: lgt, lge, llt, lle, char, ichar, iachar - public :: to_lower, to_upper, to_title, to_sentence, reverse, move + public :: to_lower, to_upper, to_title, to_sentence, move public :: assignment(=) public :: operator(>), operator(>=), operator(<), operator(<=) public :: operator(==), operator(/=), operator(//) @@ -141,14 +141,6 @@ module stdlib_string_type module procedure :: to_sentence_string end interface to_sentence - !> Reverses the character sequence hold by the input string - !> - !> This method is elemental and returns a new string_type instance which holds this - !> reverse character sequence - interface reverse - module procedure :: reverse_string - end interface reverse - !> Return the character sequence represented by the string. !> !> This method is elemental and returns a scalar character value. @@ -552,16 +544,6 @@ contains end function to_sentence_string - !> Reverse the character sequence hold by the input string - elemental function reverse_string(string) result(reversed_string) - type(string_type), intent(in) :: string - type(string_type) :: reversed_string - - reversed_string%raw = reverse_(maybe(string)) - - end function reverse_string - - !> Position of a sequence of character within a character sequence. !> In this version both character sequences are represented by a string. elemental function index_string_string(string, substring, back) result(pos) diff --git a/src/stdlib_strings.fypp b/src/stdlib_strings.fypp index a70bb38d2..d6f382fc6 100644 --- a/src/stdlib_strings.fypp +++ b/src/stdlib_strings.fypp @@ -15,6 +15,7 @@ module stdlib_strings public :: strip, chomp public :: starts_with, ends_with public :: slice, find, replace_all, padl, padr, count, zfill + public :: reverse !> Version: experimental !> @@ -164,6 +165,13 @@ module stdlib_strings module procedure :: zfill_char end interface zfill + !> Returns a new character sequence which is reverse of + !> the input charater sequence + !> This method is pure and returns a character sequence + interface reverse + module procedure :: reverse + end interface reverse + contains @@ -942,6 +950,22 @@ contains res = padl(string, output_length, "0") end function zfill_char + + !> Reverse the character order in the input character variable + !> ([Specification](../page/specs/stdlib_strings.html#reverse)) + !> + !> Version: experimental + pure function reverse(string) result(reverse_string) + character(len=*), intent(in) :: string + character(len=len(string)) :: reverse_string + integer :: i, n + + n = len(string) + do i = 1, n + reverse_string(n-i+1:n-i+1) = string(i:i) + end do + + end function reverse end module stdlib_strings diff --git a/test/ascii/test_ascii.f90 b/test/ascii/test_ascii.f90 index 5a8878632..b3252341a 100644 --- a/test/ascii/test_ascii.f90 +++ b/test/ascii/test_ascii.f90 @@ -5,7 +5,7 @@ module test_ascii whitespace, letters, is_alphanum, is_alpha, is_lower, is_upper, & is_digit, is_octal_digit, is_hex_digit, is_white, is_blank, & is_control, is_punctuation, is_graphical, is_printable, is_ascii, & - to_lower, to_upper, to_title, to_sentence, reverse, LF, TAB, NUL, DEL + to_lower, to_upper, to_title, to_sentence, LF, TAB, NUL, DEL use stdlib_kinds, only : int8, int16, int32, int64, lk implicit none private @@ -55,8 +55,8 @@ subroutine collect_ascii(testsuite) new_unittest("to_upper_string", test_to_upper_string), & new_unittest("to_lower_string", test_to_lower_string), & new_unittest("to_title_string", test_to_title_string), & - new_unittest("to_sentence_string", test_to_sentence_string), & - new_unittest("reverse_string", test_reverse_string) & + new_unittest("to_sentence_string", test_to_sentence_string) & + ! new_unittest("reverse_string", test_reverse_string) & ] end subroutine collect_ascii @@ -901,30 +901,30 @@ subroutine test_to_sentence_string(error) if (allocated(error)) return end subroutine test_to_sentence_string - subroutine test_reverse_string(error) - !> Error handling - type(error_type), allocatable, intent(out) :: error + ! subroutine test_reverse_string(error) + ! !> Error handling + ! type(error_type), allocatable, intent(out) :: error - character(len=:), allocatable :: dlc - character(len=32), parameter :: input = "reversed" + ! character(len=:), allocatable :: dlc + ! character(len=32), parameter :: input = "reversed" - dlc = reverse("reversed") - call check(error, dlc, "desrever") - if (allocated(error)) return + ! dlc = reverse("reversed") + ! call check(error, dlc, "desrever") + ! if (allocated(error)) return - dlc = reverse(input) - call check(error, len(dlc), 32) - if (allocated(error)) return + ! dlc = reverse(input) + ! call check(error, len(dlc), 32) + ! if (allocated(error)) return - call check(error, len_trim(dlc), 32) - if (allocated(error)) return + ! call check(error, len_trim(dlc), 32) + ! if (allocated(error)) return - call check(error, trim(dlc), " desrever") - if (allocated(error)) return + ! call check(error, trim(dlc), " desrever") + ! if (allocated(error)) return - call check(error, trim(adjustl(dlc)), "desrever") - if (allocated(error)) return - end subroutine test_reverse_string + ! call check(error, trim(adjustl(dlc)), "desrever") + ! if (allocated(error)) return + ! end subroutine test_reverse_string end module test_ascii diff --git a/test/io/test_parse_mode.f90 b/test/io/test_parse_mode.f90 index b9b4f2e78..c545a6d12 100644 --- a/test/io/test_parse_mode.f90 +++ b/test/io/test_parse_mode.f90 @@ -1,5 +1,6 @@ module test_parse_mode - use stdlib_ascii, only: reverse + ! use stdlib_ascii, only: reverse + use stdlib_strings, only: reverse use stdlib_io, only: parse_mode use testdrive, only: new_unittest, unittest_type, error_type, check implicit none diff --git a/test/string/test_string_functions.f90 b/test/string/test_string_functions.f90 index d62d87d3f..6023759bd 100644 --- a/test/string/test_string_functions.f90 +++ b/test/string/test_string_functions.f90 @@ -3,10 +3,10 @@ module test_string_functions use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_string_type, only : string_type, assignment(=), operator(==), & - to_lower, to_upper, to_title, to_sentence, reverse + to_lower, to_upper, to_title, to_sentence use stdlib_strings, only: slice, find, replace_all, padl, padr, count, zfill use stdlib_optval, only: optval - use stdlib_strings, only : to_string + use stdlib_strings, only : to_string, reverse implicit none contains diff --git a/test/string/test_string_match.f90 b/test/string/test_string_match.f90 index a41821b10..cad2beb36 100644 --- a/test/string/test_string_match.f90 +++ b/test/string/test_string_match.f90 @@ -1,8 +1,8 @@ ! SPDX-Identifier: MIT module test_string_match use testdrive, only : new_unittest, unittest_type, error_type, check - use stdlib_ascii, only : reverse - use stdlib_strings, only : starts_with, ends_with + ! use stdlib_ascii, only : reverse + use stdlib_strings, only : starts_with, ends_with, reverse use stdlib_string_type, only : string_type implicit none