dVAR;
register I32 paren;
register char *s = NULL;
- register I32 i;
register REGEXP *rx;
const char * const remaining = mg->mg_ptr + 1;
const char nextchar = *remaining;
}
}
break;
- case '\020': /* ^P */
- sv_setiv(sv, (IV)PL_perldb);
+ case '\020':
+ if (nextchar == '\0') { /* ^P */
+ sv_setiv(sv, (IV)PL_perldb);
+ } else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
+ goto do_prematch_fetch;
+ } else if (strEQ(remaining, "OSTMATCH")) { /* $^POSTMATCH */
+ goto do_postmatch_fetch;
+ }
break;
case '\023': /* ^S */
if (nextchar == '\0') {
SvPOK_only(sv);
}
break;
+ case '\015': /* $^MATCH */
+ if (strEQ(remaining, "ATCH")) {
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
- if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- I32 s1, t1;
-
- /*
- * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
- * XXX Does the new way break anything?
- */
- paren = atoi(mg->mg_ptr); /* $& is in [0] */
- getparen:
- if (paren <= (I32)rx->nparens &&
- (s1 = rx->startp[paren]) != -1 &&
- (t1 = rx->endp[paren]) != -1)
- {
- i = t1 - s1;
- s = rx->subbeg + s1;
- assert(rx->subbeg);
- assert(rx->sublen >= s1);
-
- getrx:
- if (i >= 0) {
- const int oldtainted = PL_tainted;
- TAINT_NOT;
- sv_setpvn(sv, s, i);
- PL_tainted = oldtainted;
- if ( (rx->extflags & RXf_CANY_SEEN)
- ? (RX_MATCH_UTF8(rx)
- && (!i || is_utf8_string((U8*)s, i)))
- : (RX_MATCH_UTF8(rx)) )
- {
- SvUTF8_on(sv);
- }
- else
- SvUTF8_off(sv);
- if (PL_tainting) {
- if (RX_MATCH_TAINTED(rx)) {
- MAGIC* const mg = SvMAGIC(sv);
- MAGIC* mgt;
- PL_tainted = 1;
- SvMAGIC_set(sv, mg->mg_moremagic);
- SvTAINT(sv);
- if ((mgt = SvMAGIC(sv))) {
- mg->mg_moremagic = mgt;
- SvMAGIC_set(sv, mg);
- }
- } else
- SvTAINTED_off(sv);
- }
- break;
- }
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ /*
+ * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
+ * XXX Does the new way break anything?
+ */
+ paren = atoi(mg->mg_ptr); /* $& is in [0] */
+ reg_numbered_buff_get( paren, rx, sv, 0);
+ break;
}
+ sv_setsv(sv,&PL_sv_undef);
}
- sv_setsv(sv,&PL_sv_undef);
break;
case '+':
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- paren = rx->lastparen;
- if (paren)
- goto getparen;
+ if (rx->lastparen) {
+ reg_numbered_buff_get( rx->lastparen, rx, sv, 0);
+ break;
+ }
}
sv_setsv(sv,&PL_sv_undef);
break;
case '\016': /* ^N */
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- paren = rx->lastcloseparen;
- if (paren)
- goto getparen;
+ if (rx->lastcloseparen) {
+ reg_numbered_buff_get( rx->lastcloseparen, rx, sv, 0);
+ break;
+ }
+
}
sv_setsv(sv,&PL_sv_undef);
break;
case '`':
+ do_prematch_fetch:
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- if ((s = rx->subbeg) && rx->startp[0] != -1) {
- i = rx->startp[0];
- goto getrx;
- }
+ reg_numbered_buff_get( -2, rx, sv, 0);
+ break;
}
sv_setsv(sv,&PL_sv_undef);
break;
case '\'':
+ do_postmatch_fetch:
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
- if (rx->subbeg && rx->endp[0] != -1) {
- s = rx->subbeg + rx->endp[0];
- i = rx->sublen - rx->endp[0];
- goto getrx;
- }
+ reg_numbered_buff_get( -1, rx, sv, 0);
+ break;
}
sv_setsv(sv,&PL_sv_undef);
break;
if (he)
value = HeVAL(he);
if (!value || value == &PL_sv_undef)
- Perl_croak(aTHX_ PL_no_helem_sv, mg->mg_obj);
+ Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj));
}
else {
AV* const av = (AV*)LvTARG(sv);