# define Perl_regprop my_regprop
/* *These* symbols are masked to allow static link. */
# define Perl_pregexec my_pregexec
+# define Perl_reginitcolors my_reginitcolors
#endif
/*SUPPRESS 112*/
STATIC void
restore_pos(void *arg)
-{
+{
+ dTHR;
if (PL_reg_eval_set) {
PL_reg_magic->mg_len = PL_reg_oldpos;
PL_reg_eval_set = 0;
+ PL_curpm = PL_reg_oldcurpm;
}
}
s = startpos;
}
- DEBUG_r(
- PerlIO_printf(Perl_debug_log,
+ DEBUG_r(if (!PL_colorset) reginitcolors());
+ DEBUG_r(PerlIO_printf(Perl_debug_log,
"%sMatching%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
PL_colors[4],PL_colors[5],PL_colors[0],
prog->precomp,
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. */
}
}
}
- /* 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:
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 (PL_reg_sv != DEFSV) {
+ /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+ SAVESPTR(DEFSV);
+ DEFSV = PL_reg_sv;
}
if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
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;
PL_reglastparen = &prog->lastparen;
prog->lastparen = 0;
PL_regsize = 0;
+ DEBUG_r(PL_reg_starttry = startpos);
if (PL_reg_start_tmpl <= prog->nparens) {
PL_reg_start_tmpl = prog->nparens*3/2 + 3;
if(PL_reg_start_tmp)
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;
}
int l = (PL_regeol - locinput > taill ? taill : PL_regeol - locinput);
int pref_len = (locinput - PL_bostr > (5 + taill) - l
? (5 + taill) - l : locinput - PL_bostr);
- int pref0_len = pref_len - (locinput - PL_reginput);
+ int pref0_len = pref_len - (locinput - PL_reg_starttry);
if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
l = ( PL_regeol - locinput > (5 + taill) - pref_len
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;
}
/*
- - regclass - determine if a character falls into a character class
+ - reginclass - determine if a character falls into a character class
*/
STATIC bool