diff options
| -rw-r--r-- | embed.h | 1 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | embedvar.h | 6 | ||||
| -rw-r--r-- | objXSUB.h | 6 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | regexec.c | 38 | ||||
| -rwxr-xr-x | t/op/pat.t | 49 | ||||
| -rw-r--r-- | thrdvar.h | 2 |
9 files changed, 104 insertions, 2 deletions
@@ -1926,6 +1926,7 @@ #define restore_expect CPerlObj::Perl_restore_expect #define restore_lex_expect CPerlObj::Perl_restore_lex_expect #define restore_magic CPerlObj::Perl_restore_magic +#define restore_pos CPerlObj::Perl_restore_pos #define restore_rsfp CPerlObj::Perl_restore_rsfp #define rninstr CPerlObj::Perl_rninstr #define rsignal CPerlObj::Perl_rsignal @@ -360,6 +360,7 @@ my @staticfuncs = qw( regcppop regcp_set_to cache_re + restore_pos reghop reghopmaybe dump diff --git a/embedvar.h b/embedvar.h index 733347d637..b1aad3aca1 100644 --- a/embedvar.h +++ b/embedvar.h @@ -56,6 +56,8 @@ #define PL_reg_eval_set (PL_curinterp->Treg_eval_set) #define PL_reg_flags (PL_curinterp->Treg_flags) #define PL_reg_ganch (PL_curinterp->Treg_ganch) +#define PL_reg_magic (PL_curinterp->Treg_magic) +#define PL_reg_oldpos (PL_curinterp->Treg_oldpos) #define PL_reg_re (PL_curinterp->Treg_re) #define PL_reg_start_tmp (PL_curinterp->Treg_start_tmp) #define PL_reg_start_tmpl (PL_curinterp->Treg_start_tmpl) @@ -442,6 +444,8 @@ #define PL_Treg_eval_set PL_reg_eval_set #define PL_Treg_flags PL_reg_flags #define PL_Treg_ganch PL_reg_ganch +#define PL_Treg_magic PL_reg_magic +#define PL_Treg_oldpos PL_reg_oldpos #define PL_Treg_re PL_reg_re #define PL_Treg_start_tmp PL_reg_start_tmp #define PL_Treg_start_tmpl PL_reg_start_tmpl @@ -571,6 +575,8 @@ #define PL_reg_eval_set (thr->Treg_eval_set) #define PL_reg_flags (thr->Treg_flags) #define PL_reg_ganch (thr->Treg_ganch) +#define PL_reg_magic (thr->Treg_magic) +#define PL_reg_oldpos (thr->Treg_oldpos) #define PL_reg_re (thr->Treg_re) #define PL_reg_start_tmp (thr->Treg_start_tmp) #define PL_reg_start_tmpl (thr->Treg_start_tmpl) @@ -500,6 +500,10 @@ #define PL_reg_flags pPerl->PL_reg_flags #undef PL_reg_ganch #define PL_reg_ganch pPerl->PL_reg_ganch +#undef PL_reg_magic +#define PL_reg_magic pPerl->PL_reg_magic +#undef PL_reg_oldpos +#define PL_reg_oldpos pPerl->PL_reg_oldpos #undef PL_reg_re #define PL_reg_re pPerl->PL_reg_re #undef PL_reg_start_tmp @@ -2643,6 +2647,8 @@ #define restore_lex_expect pPerl->Perl_restore_lex_expect #undef restore_magic #define restore_magic pPerl->Perl_restore_magic +#undef restore_pos +#define restore_pos pPerl->Perl_restore_pos #undef restore_rsfp #define restore_rsfp pPerl->Perl_restore_rsfp #undef rninstr @@ -164,7 +164,7 @@ PP(pp_substcont) /* Are we done */ if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig, - s == m, Nullsv, cx->sb_targ, + s == m, cx->sb_targ, NULL, ((cx->sb_rflags & REXEC_COPY_STR) ? 0 : REXEC_COPY_STR))) { @@ -873,6 +873,7 @@ CHECKPOINT regcppush _((I32 parenfloor)); char * regcppop _((void)); char * regcp_set_to _((I32 ss)); void cache_re _((regexp *prog)); +void restore_pos _((void *arg)); U8 * reghop _((U8 *pos, I32 off)); U8 * reghopmaybe _((U8 *pos, I32 off)); void dump _((char *pat,...)); @@ -108,6 +108,7 @@ static CHECKPOINT regcppush _((I32 parenfloor)); static char * regcppop _((void)); static char * regcp_set_to _((I32 ss)); static void cache_re _((regexp *prog)); +static void restore_pos _((void *arg)); #endif #define REGINCLASS(p,c) (*(p) ? reginclass(p,c) : ANYOF_TEST(p,c)) @@ -260,6 +261,16 @@ cache_re(regexp *prog) PL_reg_re = prog; } +STATIC void +restore_pos(void *arg) +{ + if (PL_reg_eval_set) { + PL_reg_magic->mg_len = PL_reg_oldpos; + PL_reg_eval_set = 0; + } +} + + /* - regexec_flags - match a regexp against a string */ @@ -327,6 +338,7 @@ regexec_flags(register regexp *prog, char *stringarg, register char *strend, /* Mark beginning of line for ^ and lookbehind. */ PL_regbol = startpos; PL_bostr = strbeg; + PL_reg_sv = sv; /* Mark end of line for $ (and such) */ PL_regeol = strend; @@ -1002,9 +1014,13 @@ got_it: restored, the value remains the same. */ } + if (PL_reg_eval_set) + restore_pos(0); return 1; phooey: + if (PL_reg_eval_set) + restore_pos(0); return 0; } @@ -1021,6 +1037,8 @@ regtry(regexp *prog, char *startpos) CHECKPOINT lastcp; if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) { + MAGIC *mg; + PL_reg_eval_set = RS_init; DEBUG_r(DEBUG_s( PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n", @@ -1033,6 +1051,25 @@ regtry(regexp *prog, char *startpos) /* Apparently this is not needed, judging by wantarray. */ /* SAVEINT(cxstack[cxstack_ix].blk_gimme); cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ + + if (PL_reg_sv) { + /* Make $_ available to executed code. */ + if (PL_reg_sv != GvSV(PL_defgv)) { + SAVESPTR(GvSV(PL_defgv)); + GvSV(PL_defgv) = PL_reg_sv; + } + + if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) + && (mg = mg_find(PL_reg_sv, 'g')))) { + /* prepare for quick setting of pos */ + sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0); + mg = mg_find(PL_reg_sv, 'g'); + mg->mg_len = -1; + } + PL_reg_magic = mg; + PL_reg_oldpos = mg->mg_len; + SAVEDESTRUCTOR(restore_pos, 0); + } } PL_reginput = startpos; PL_regstartp = prog->startp; @@ -1604,6 +1641,7 @@ regmatch(regnode *prog) PL_op = (OP_4tree*)PL_regdata->data[n]; DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) ); PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 1]); + PL_reg_magic->mg_len = locinput - PL_bostr; CALLRUNOPS(); /* Scalar context. */ SPAGAIN; diff --git a/t/op/pat.t b/t/op/pat.t index 12b939708a..7b8dc59cf6 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..168\n"; +print "1..174\n"; BEGIN { chdir 't' if -d 't'; @@ -719,6 +719,53 @@ print "not " unless $str =~ /\G../ and $& eq 'cd'; print "ok $test\n"; $test++; +undef $foo; undef $bar; +print "#'$str','$foo','$bar'\nnot " + unless $str =~ /b(?{$foo = $_; $bar = pos})c/ + and $foo eq 'abcde' and $bar eq 2; +print "ok $test\n"; +$test++; + +undef $foo; undef $bar; +pos $str = undef; +print "#'$str','$foo','$bar'\nnot " + unless $str =~ /b(?{$foo = $_; $bar = pos})c/g + and $foo eq 'abcde' and $bar eq 2 and pos $str eq 3; +print "ok $test\n"; +$test++; + +$_ = $str; + +undef $foo; undef $bar; +print "#'$str','$foo','$bar'\nnot " + unless /b(?{$foo = $_; $bar = pos})c/ + and $foo eq 'abcde' and $bar eq 2; +print "ok $test\n"; +$test++; + +undef $foo; undef $bar; +print "#'$str','$foo','$bar'\nnot " + unless /b(?{$foo = $_; $bar = pos})c/g + and $foo eq 'abcde' and $bar eq 2 and pos eq 3; +print "ok $test\n"; +$test++; + +undef $foo; undef $bar; +pos = undef; +1 while /b(?{$foo = $_; $bar = pos})c/g; +print "#'$str','$foo','$bar'\nnot " + unless $foo eq 'abcde' and $bar eq 2 and not defined pos; +print "ok $test\n"; +$test++; + +undef $foo; undef $bar; +$_ = 'abcde|abcde'; +print "#'$str','$foo','$bar','$_'\nnot " + unless s/b(?{$foo = $_; $bar = pos})c/x/g and $foo eq 'abcde|abcde' + and $bar eq 8 and $_ eq 'axde|axde'; +print "ok $test\n"; +$test++; + # see if matching against temporaries (created via pp_helem()) is safe { foo => "ok $test\n".$^X }->{foo} =~ /^(.*)\n/g; print "$1\n"; @@ -158,6 +158,8 @@ PERLVAR(Treg_call_cc, struct re_cc_state *) /* from regexec.c */ PERLVAR(Treg_re, regexp *) /* from regexec.c */ PERLVAR(Treg_ganch, char *) /* position of \G */ PERLVAR(Treg_sv, SV *) /* what we match against */ +PERLVAR(Treg_magic, MAGIC *) /* pos-magic of what we match */ +PERLVAR(Treg_oldpos, I32) /* old pos of what we match */ PERLVARI(Tregcompp, regcomp_t, FUNC_NAME_TO_PTR(pregcomp)) /* Pointer to RE compiler */ |