Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit e325c2b

Browse files
committedJun 20, 2021
implemented replace_all function, added some test_cases for replace_all
1 parent d0fea86 commit e325c2b

File tree

2 files changed

+78
-2
lines changed

2 files changed

+78
-2
lines changed
 

‎src/stdlib_strings.f90

Lines changed: 65 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ module stdlib_strings
1212

1313
public :: strip, chomp
1414
public :: starts_with, ends_with
15-
public :: slice, find
15+
public :: slice, find, replace_all
1616

1717

1818
!> Remove leading and trailing whitespace characters.
@@ -79,6 +79,20 @@ module stdlib_strings
7979
module procedure :: find_char_char
8080
end interface find
8181

82+
!> Replaces all the occurrences of substring 'pattern' in the input 'string'
83+
!> with the replacement 'replacement'
84+
!> Version: experimental
85+
interface replace_all
86+
!module procedure :: replace_all_string_string_string
87+
!module procedure :: replace_all_string_string_char
88+
!module procedure :: replace_all_string_char_string
89+
!module procedure :: replace_all_char_string_string
90+
!module procedure :: replace_all_string_char_char
91+
!module procedure :: replace_all_char_string_char
92+
!module procedure :: replace_all_char_char_string
93+
module procedure :: replace_all_char_char_char
94+
end interface replace_all
95+
8296
contains
8397

8498

@@ -499,5 +513,55 @@ pure function compute_lps(string) result(lps_array)
499513

500514
end function compute_lps
501515

516+
!> Replaces all the occurrences of substring 'pattern' in the input 'string'
517+
!> with the replacement 'replacement'
518+
!> Returns a new string
519+
pure function replace_all_char_char_char(string, pattern, replacement, replace_overlapping) result(res)
520+
character(len=*), intent(in) :: string
521+
character(len=*), intent(in) :: pattern
522+
character(len=*), intent(in) :: replacement
523+
logical, intent(in), optional :: replace_overlapping
524+
character(:), allocatable :: res
525+
integer :: lps_array(len(pattern))
526+
integer :: s_i, p_i, last, length_string, length_pattern
527+
logical :: replace_overlapping_
528+
529+
res = ""
530+
replace_overlapping_ = optval(replace_overlapping, .false.)
531+
length_string = len(string)
532+
length_pattern = len(pattern)
533+
last = 1
534+
535+
if (length_pattern > 0 .and. length_pattern <= length_string) then
536+
lps_array = compute_lps(pattern)
537+
538+
s_i = 1
539+
p_i = 1
540+
do while(s_i <= length_string)
541+
if (string(s_i:s_i) == pattern(p_i:p_i)) then
542+
if (p_i == length_pattern) then
543+
res = res // &
544+
& slice(string, first=last, last=s_i - length_pattern, stride=1) // &
545+
& replacement
546+
last = s_i + 1
547+
if (replace_overlapping_) then
548+
p_i = lps_array(p_i)
549+
else
550+
p_i = 0
551+
end if
552+
end if
553+
s_i = s_i + 1
554+
p_i = p_i + 1
555+
else if (p_i > 1) then
556+
p_i = lps_array(p_i - 1) + 1
557+
else
558+
s_i = s_i + 1
559+
end if
560+
end do
561+
end if
562+
563+
res = res // slice(string, first=last)
564+
565+
end function replace_all_char_char_char
502566

503567
end module stdlib_strings

‎src/tests/string/test_string_functions.f90

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module test_string_functions
44
use stdlib_error, only : check
55
use stdlib_string_type, only : string_type, assignment(=), operator(==), &
66
to_lower, to_upper, to_title, to_sentence, reverse
7-
use stdlib_strings, only: slice, find
7+
use stdlib_strings, only: slice, find, replace_all
88
use stdlib_optval, only: optval
99
use stdlib_ascii, only : to_string
1010
implicit none
@@ -318,6 +318,17 @@ pure function carray_to_string(carray) result(string)
318318
string = transfer(carray, string)
319319
end function carray_to_string
320320

321+
subroutine test_replace_all
322+
character(len=:), allocatable :: test_string
323+
test_string = "qwqwqwqwqwqwqwqwpqr"
324+
call check(replace_all(test_string, "qwq", "wqw", .true.) == "wqwwqwwqwwqwwqwwqwwqwwpqr")
325+
call check(replace_all(test_string, "qwq", "abcd") == "abcdwabcdwabcdwabcdwpqr")
326+
call check(replace_all(test_string, "", "abcd") == test_string)
327+
328+
call check(replace_all("", "qwq", "abcd") == "")
329+
330+
end subroutine test_replace_all
331+
321332
end module test_string_functions
322333

323334

@@ -333,5 +344,6 @@ program tester
333344
call test_slice_string
334345
call test_slice_gen
335346
call test_find
347+
call test_replace_all
336348

337349
end program tester

0 commit comments

Comments
 (0)
Please sign in to comment.