diff options
| -rw-r--r-- | embedvar.h | 6 | ||||
| -rw-r--r-- | mg.c | 4 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | regexec.c | 35 | ||||
| -rwxr-xr-x | t/op/pat.t | 27 | ||||
| -rw-r--r-- | thrdvar.h | 2 |
7 files changed, 66 insertions, 14 deletions
diff --git a/embedvar.h b/embedvar.h index 9d82427948..4d28711ee5 100644 --- a/embedvar.h +++ b/embedvar.h @@ -53,10 +53,12 @@ #define PL_op (PL_curinterp->Top) #define PL_opsave (PL_curinterp->Topsave) #define PL_reg_call_cc (PL_curinterp->Treg_call_cc) +#define PL_reg_curpm (PL_curinterp->Treg_curpm) #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_oldcurpm (PL_curinterp->Treg_oldcurpm) #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) @@ -442,10 +444,12 @@ #define PL_Top PL_op #define PL_Topsave PL_opsave #define PL_Treg_call_cc PL_reg_call_cc +#define PL_Treg_curpm PL_reg_curpm #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_oldcurpm PL_reg_oldcurpm #define PL_Treg_oldpos PL_reg_oldpos #define PL_Treg_re PL_reg_re #define PL_Treg_start_tmp PL_reg_start_tmp @@ -574,10 +578,12 @@ #define PL_op (thr->Top) #define PL_opsave (thr->Topsave) #define PL_reg_call_cc (thr->Treg_call_cc) +#define PL_reg_curpm (thr->Treg_curpm) #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_oldcurpm (thr->Treg_oldcurpm) #define PL_reg_oldpos (thr->Treg_oldpos) #define PL_reg_re (thr->Treg_re) #define PL_reg_start_tmp (thr->Treg_start_tmp) @@ -350,9 +350,9 @@ magic_regdatum_get(SV *sv, MAGIC *mg) (t = rx->endp[paren])) { if (mg->mg_obj) /* @+ */ - i = t - rx->subbase; + i = t - rx->subbeg; else /* @- */ - i = s - rx->subbase; + i = s - rx->subbeg; sv_setiv(sv,i); } } @@ -494,6 +494,8 @@ #define PL_profiledata pPerl->PL_profiledata #undef PL_reg_call_cc #define PL_reg_call_cc pPerl->PL_reg_call_cc +#undef PL_reg_curpm +#define PL_reg_curpm pPerl->PL_reg_curpm #undef PL_reg_eval_set #define PL_reg_eval_set pPerl->PL_reg_eval_set #undef PL_reg_flags @@ -502,6 +504,8 @@ #define PL_reg_ganch pPerl->PL_reg_ganch #undef PL_reg_magic #define PL_reg_magic pPerl->PL_reg_magic +#undef PL_reg_oldcurpm +#define PL_reg_oldcurpm pPerl->PL_reg_oldcurpm #undef PL_reg_oldpos #define PL_reg_oldpos pPerl->PL_reg_oldpos #undef PL_reg_re @@ -547,6 +547,8 @@ perl_destruct(register PerlInterpreter *sv_interp) Safefree(PL_origfilename); Safefree(PL_archpat_auto); Safefree(PL_reg_start_tmp); + if (PL_reg_curpm) + Safefree(PL_reg_curpm); Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh)); Safefree(PL_op_mask); nuke_stacks(); @@ -268,6 +268,7 @@ restore_pos(void *arg) if (PL_reg_eval_set) { PL_reg_magic->mg_len = PL_reg_oldpos; PL_reg_eval_set = 0; + PL_curpm = PL_reg_oldcurpm; } } @@ -1011,14 +1012,15 @@ got_it: } } } - /* Preserve the current value of $^R */ - if (oreplsv != GvSV(PL_replgv)) { - sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is - restored, the value remains - the same. */ - } - if (PL_reg_eval_set) + if (PL_reg_eval_set) { + /* Preserve the current value of $^R */ + if (oreplsv != GvSV(PL_replgv)) + sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is + restored, the value remains + the same. */ restore_pos(0); + } + return 1; phooey: @@ -1073,7 +1075,15 @@ regtry(regexp *prog, char *startpos) PL_reg_oldpos = mg->mg_len; SAVEDESTRUCTOR(restore_pos, 0); } + if (!PL_reg_curpm) + New(22,PL_reg_curpm, 1, PMOP); + PL_reg_curpm->op_pmregexp = prog; + PL_reg_oldcurpm = PL_curpm; + PL_curpm = PL_reg_curpm; + prog->subbeg = PL_bostr; + prog->subend = PL_regeol; /* strend may have been modified */ } + prog->startp[0] = startpos; PL_reginput = startpos; PL_regstartp = prog->startp; PL_regendp = prog->endp; @@ -1089,17 +1099,19 @@ regtry(regexp *prog, char *startpos) New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*); } + /* XXXX What this code is doing here?!!! There should be no need + to do this again and again, PL_reglastparen should take care of + this! */ sp = prog->startp; ep = prog->endp; if (prog->nparens) { - for (i = prog->nparens; i >= 0; i--) { - *sp++ = NULL; - *ep++ = NULL; + for (i = prog->nparens; i >= 1; i--) { + *++sp = NULL; + *++ep = NULL; } } REGCP_SET; if (regmatch(prog->program + 1)) { - prog->startp[0] = startpos; prog->endp[0] = PL_reginput; return 1; } @@ -1646,6 +1658,7 @@ regmatch(regnode *prog) 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; + PL_regendp[0] = locinput; CALLRUNOPS(); /* Scalar context. */ SPAGAIN; diff --git a/t/op/pat.t b/t/op/pat.t index 7b8dc59cf6..a289fbe08d 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..174\n"; +print "1..176\n"; BEGIN { chdir 't' if -d 't'; @@ -766,6 +766,31 @@ print "#'$str','$foo','$bar','$_'\nnot " print "ok $test\n"; $test++; +@res = (); +# List context: +$_ = 'abcde|abcde'; +@dummy = /([ace]).(?{push @res, $1,$2})([ce])(?{push @res, $1,$2})/g; +@res = map {defined $_ ? "'$_'" : 'undef'} @res; +$res = "@res"; +print "#'@res' '$_'\nnot " + unless "@res" eq "'a' undef 'a' 'c' 'e' undef 'a' undef 'a' 'c'"; +print "ok $test\n"; +$test++; + +@res = (); +@dummy = /([ace]).(?{push @res, $`,$&,$'})([ce])(?{push @res, $`,$&,$'})/g; +@res = map {defined $_ ? "'$_'" : 'undef'} @res; +$res = "@res"; +print "#'@res' '$_'\nnot " + unless "@res" eq + "'' 'ab' 'cde|abcde' " . + "'' 'abc' 'de|abcde' " . + "'abcd' 'e|' 'abcde' " . + "'abcde|' 'ab' 'cde' " . + "'abcde|' 'abc' 'de'" ; +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"; @@ -160,6 +160,8 @@ 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(Treg_oldcurpm, PMOP*, NULL) /* curpm before match */ +PERLVARI(Treg_curpm, PMOP*, NULL) /* curpm during match */ PERLVARI(Tregcompp, regcomp_t, FUNC_NAME_TO_PTR(pregcomp)) /* Pointer to RE compiler */ |