Skip to content

Commit 799c170

Browse files
committed
implemented replace_all function, added some test_cases for replace_all
1 parent 76182e2 commit 799c170

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.
@@ -78,6 +78,20 @@ module stdlib_strings
7878
module procedure :: find_char_char
7979
end interface find
8080

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

8397

@@ -498,5 +512,55 @@ pure function compute_lps(string) result(lps_array)
498512

499513
end function compute_lps
500514

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

502566
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
@@ -311,6 +311,17 @@ pure function carray_to_string(carray) result(string)
311311
string = transfer(carray, string)
312312
end function carray_to_string
313313

314+
subroutine test_replace_all
315+
character(len=:), allocatable :: test_string
316+
test_string = "qwqwqwqwqwqwqwqwpqr"
317+
call check(replace_all(test_string, "qwq", "wqw", .true.) == "wqwwqwwqwwqwwqwwqwwqwwpqr")
318+
call check(replace_all(test_string, "qwq", "abcd") == "abcdwabcdwabcdwabcdwpqr")
319+
call check(replace_all(test_string, "", "abcd") == test_string)
320+
321+
call check(replace_all("", "qwq", "abcd") == "")
322+
323+
end subroutine test_replace_all
324+
314325
end module test_string_functions
315326

316327

@@ -326,5 +337,6 @@ program tester
326337
call test_slice_string
327338
call test_slice_gen
328339
call test_find
340+
call test_replace_all
329341

330342
end program tester

0 commit comments

Comments
 (0)