diff options
| -rw-r--r-- | pp_ctl.c | 3 | ||||
| -rw-r--r-- | pp_hot.c | 6 | ||||
| -rw-r--r-- | regexec.c | 10 | ||||
| -rw-r--r-- | regexp.h | 1 | ||||
| -rwxr-xr-x | t/op/pat.t | 9 | ||||
| -rwxr-xr-x | t/op/subst.t | 138 |
6 files changed, 158 insertions, 9 deletions
@@ -166,7 +166,8 @@ PP(pp_substcont) if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig, s == m, cx->sb_targ, NULL, ((cx->sb_rflags & REXEC_COPY_STR) - ? 0 : REXEC_COPY_STR))) + ? REXEC_IGNOREPOS + : (REXEC_COPY_STR|REXEC_IGNOREPOS)))) { SV *targ = cx->sb_targ; sv_catpvn(dstr, s, cx->sb_strend - s); @@ -874,6 +874,8 @@ PP(pp_match) if (rx->minlen > len) goto failure; truebase = t = s; + + /* XXXX What part of this is needed with true \G-support? */ if (global = pm->op_pmflags & PMf_GLOBAL) { rx->startp[0] = 0; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { @@ -993,6 +995,7 @@ play_it_again: if (rx->startp[0] && rx->startp[0] == rx->endp[0]) ++rx->endp[0]; PUTBACK; /* EVAL blocks may use stack */ + r_flags |= REXEC_IGNOREPOS; goto play_it_again; } else if (!iters) @@ -1827,6 +1830,7 @@ PP(pp_subst) PUSHSUBST(cx); RETURNOP(cPMOP->op_pmreplroot); } + r_flags |= REXEC_IGNOREPOS; do { if (iters++ > maxiters) DIE("Substitution loop"); @@ -1845,7 +1849,7 @@ PP(pp_subst) sv_catpvn(dstr, c, clen); if (once) break; - } while (CALLREGEXEC(rx, s, strend, orig, s == m, Nullsv, NULL, r_flags)); + } while (CALLREGEXEC(rx, s, strend, orig, s == m, TARG, NULL, r_flags)); sv_catpvn(dstr, s, strend - s); (void)SvOOK_off(TARG); @@ -418,12 +418,12 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, if (prog->reganch & ROPT_GPOS_SEEN) { MAGIC *mg; - int pos = 0; - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) - && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) - pos = mg->mg_len; - PL_reg_ganch = startpos + pos; + if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG + && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) + PL_reg_ganch = strbeg + mg->mg_len; + else + PL_reg_ganch = startpos; } /* Simplest case: anchored match need be tried only once. */ @@ -103,6 +103,7 @@ typedef struct regexp { #define REXEC_COPY_STR 1 /* Need to copy the string. */ #define REXEC_CHECKED 2 /* check_substr already checked. */ #define REXEC_SCREAM 4 /* use scream table. */ +#define REXEC_IGNOREPOS 8 /* \G matches at start. */ #define ReREFCNT_inc(re) ((re && re->refcnt++), re) #define ReREFCNT_dec(re) pregfree(re) diff --git a/t/op/pat.t b/t/op/pat.t index 7bcc196ed1..abb10fd841 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..177\n"; +print "1..178\n"; BEGIN { chdir 't' if -d 't'; @@ -697,6 +697,13 @@ print "#$#-..$#+\nnot " if $#+ != 2 or $#- != 1; print "ok $test\n"; $test++; +$_ = 'aaa'; +pos = 1; +@a = /\Ga/g; +print "not " unless "@a" eq "a a"; +print "ok $test\n"; +$test++; + $str = 'abcde'; pos $str = 2; diff --git a/t/op/subst.t b/t/op/subst.t index 70219ab521..6b3ce5852f 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..71\n"; +print "1..91\n"; $x = 'foo'; $_ = "x"; @@ -315,3 +315,139 @@ $_ = 'x' x 20; s/\d*|x/<$&>/g; $foo = '<>' . ('<x><>' x 20) ; print ($_ eq $foo ? "ok 71\n" : "not ok 71\n#'$_'\n#'$foo'\n"); + +$t = 'aaaaaaaaa'; + +$_ = $t; +pos = 6; +s/\Ga/xx/g; +print "not " unless $_ eq 'aaaaaaxxxxxx'; +print "ok 72\n"; + +$_ = $t; +pos = 6; +s/\Ga/x/g; +print "not " unless $_ eq 'aaaaaaxxx'; +print "ok 73\n"; + +$_ = $t; +pos = 6; +s/\Ga/xx/; +print "not " unless $_ eq 'aaaaaaxxaa'; +print "ok 74\n"; + +$_ = $t; +pos = 6; +s/\Ga/x/; +print "not " unless $_ eq 'aaaaaaxaa'; +print "ok 75\n"; + +$_ = $t; +s/\Ga/xx/g; +print "not " unless $_ eq 'xxxxxxxxxxxxxxxxxx'; +print "ok 76\n"; + +$_ = $t; +s/\Ga/x/g; +print "not " unless $_ eq 'xxxxxxxxx'; +print "ok 77\n"; + +$_ = $t; +s/\Ga/xx/; +print "not " unless $_ eq 'xxaaaaaaaa'; +print "ok 78\n"; + +$_ = $t; +s/\Ga/x/; +print "not " unless $_ eq 'xaaaaaaaa'; +print "ok 79\n"; + +$t = 'aaa'; + +$_ = $t; +@res = (); +pos = 1; +s/\Ga(?{push @res, $_, $`})/xx/g; +print "not " unless "$_ @res" eq 'axxxx aaa a aaa aa'; +print "ok 80\n"; + +$_ = $t; +@res = (); +pos = 1; +s/\Ga(?{push @res, $_, $`})/x/g; +print "not " unless "$_ @res" eq 'axx aaa a aaa aa'; +print "ok 81\n"; + +$_ = $t; +@res = (); +pos = 1; +s/\Ga(?{push @res, $_, $`})/xx/; +print "not " unless "$_ @res" eq 'axxa aaa a'; +print "ok 82\n"; + +$_ = $t; +@res = (); +pos = 1; +s/\Ga(?{push @res, $_, $`})/x/; +print "not " unless "$_ @res" eq 'axa aaa a'; +print "ok 83\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/xx/g; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa'; +print "ok 84\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x/g; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa'; +print "ok 85\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/xx/; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a'; +print "ok 86\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x/; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a'; +print "ok 87\n"; + +sub x2 {'xx'} +sub x1 {'x'} + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x2/ge; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa'; +print "ok 88\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x1/ge; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa'; +print "ok 89\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x2/e; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a'; +print "ok 90\n"; + +$a = $t; +@res = (); +pos ($a) = 1; +$a =~ s/\Ga(?{push @res, $_, $`})/x1/e; +print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a'; +print "ok 91\n"; + |