use warnings; use strict; use Test::More # tests => ?? + 1 # Test::NoWarnings adds 1 test 'no_plan' ; use Test::NoWarnings; my $f1 = qr{ foo | (?i: bar) | baz }xms; # find regex my $r1 = qq{Zonk}; # replacement string for my $ar_vector ( # test vectors # i find replace target expected # regex string string string [ 0, $f1, $r1, '', '', ], [ 1, $f1, $r1, '', '', ], [ 2, $f1, $r1, '', '', ], [ 0, $f1, $r1, 'x', 'x', ], [ 1, $f1, $r1, 'x', 'x', ], [ 2, $f1, $r1, 'x', 'x', ], [ 0, $f1, $r1, 'foo', 'Zonk', ], [ 1, $f1, $r1, 'foo', 'foo', ], [ 2, $f1, $r1, 'foo', 'foo', ], [ 0, $f1, $r1, 'xfoo', 'xZonk', ], [ 0, $f1, $r1, 'foox', 'Zonkx', ], [ 0, $f1, $r1, 'xfoox', 'xZonkx', ], [ 0, $f1, $r1, 'xfoofoox', 'xZonkfoox', ], [ 0, $f1, $r1, 'xfooxfoox', 'xZonkxfoox', ], [ 1, $f1, $r1, 'xfoo', 'xfoo', ], [ 1, $f1, $r1, 'foox', 'foox', ], [ 1, $f1, $r1, 'xfoox', 'xfoox', ], [ 1, $f1, $r1, 'xfoofoox', 'xfooZonkx', ], [ 1, $f1, $r1, 'xfooxfoox', 'xfooxZonkx', ], [ 2, $f1, $r1, 'xfoo', 'xfoo', ], [ 2, $f1, $r1, 'foox', 'foox', ], [ 2, $f1, $r1, 'xfoox', 'xfoox', ], [ 2, $f1, $r1, 'xfoofoox', 'xfoofoox', ], [ 2, $f1, $r1, 'xfooxfoox', 'xfooxfoox', ], [ 0, $f1, $r1, 'BAR', 'Zonk', ], [ 0, $f1, $r1, 'BAR', 'Zonk', ], [ 0, $f1, $r1, 'BARx', 'Zonkx', ], [ 0, $f1, $r1, 'xBARx', 'xZonkx', ], [ 0, $f1, $r1, 'BarbAR', 'ZonkbAR', ], [ 0, $f1, $r1, 'xBarbAR', 'xZonkbAR', ], [ 0, $f1, $r1, 'BarxbAR', 'ZonkxbAR', ], [ 0, $f1, $r1, 'BarbARx', 'ZonkbARx', ], [ 0, $f1, $r1, 'xBarxbARx', 'xZonkxbARx', ], [ 1, $f1, $r1, 'BarbAR', 'BarZonk', ], [ 1, $f1, $r1, 'xBarbAR', 'xBarZonk', ], [ 1, $f1, $r1, 'BarxbAR', 'BarxZonk', ], [ 1, $f1, $r1, 'BarbARx', 'BarZonkx', ], [ 1, $f1, $r1, 'xBarxbARx', 'xBarxZonkx', ], [ 2, $f1, $r1, 'BarbAR', 'BarbAR', ], [ 2, $f1, $r1, 'xBarbAR', 'xBarbAR', ], [ 2, $f1, $r1, 'BarxbAR', 'BarxbAR', ], [ 2, $f1, $r1, 'BarbARx', 'BarbARx', ], [ 2, $f1, $r1, 'xBarxbARx', 'xBarxbARx', ], ) { my ($i, $find, $repl, $target, $expected) = @$ar_vector; my $got = replace_ith($i, $find, $repl, $target); is $got, $expected, qq{'$target' -> '$expected'}; } # end for test_vectors # subroutines ###################################################### sub replace_ith { my ($i, # 0-based index of occurrence of pattern to be replaced $find, # find pattern: Regexp object $repl, # replacement string $string, # string to be searched/replaced ) = @_; $string =~ s{ # (?: $find (?: (?! $find) . )*){$i} # ok (?: $find (?: .*? (?= $find))){$i} # ok - maybe faster? \K $find } {$repl}xms; return $string; }