}
}
-void
-Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
+static void
+S_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
{
UV *p = (UV*)*rsp;
U32 i;
}
}
-void
-Perl_rxres_free(pTHX_ void **rsp)
+static void
+S_rxres_free(pTHX_ void **rsp)
{
UV * const p = (UV*)*rsp;
if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
*t = '\0';
- sv_utf8_upgrade(PL_formtarget);
- SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+ sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC, fudge + 1);
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
if (!targ_is_utf8) {
SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
*t = '\0';
- sv_utf8_upgrade(PL_formtarget);
- SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
+ sv_utf8_upgrade_flags_grow(PL_formtarget, SV_GMAGIC,
+ fudge + 1);
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
t - SvPVX_const(PL_formtarget));
targ_is_utf8 = TRUE;
/* Don't need get magic. */
- sv_utf8_upgrade_flags(PL_formtarget, 0);
+ sv_utf8_upgrade_nomg(PL_formtarget);
} else {
SvCUR_set(PL_formtarget,
t - SvPVX_const(PL_formtarget));
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
SV **bits_all;
- HV * const bits = get_hv("warnings::Bits", FALSE);
+ HV * const bits = get_hv("warnings::Bits", 0);
if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
mask = newSVsv(*bits_all);
}
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
- CV * const gotocv = get_cv("DB::goto", FALSE);
+ CV * const gotocv = get_cvs("DB::goto", 0);
if (gotocv) {
PUSHMARK( PL_stack_sp );
call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG);
POPEVAL(cx);
}
lex_end();
- LEAVE;
+ LEAVE; /* pp_entereval knows about this LEAVE. */
msg = SvPVx_nolen_const(ERRSV);
if (optype == OP_REQUIRE) {
/* Register with debugger: */
if (PERLDB_INTER && saveop && saveop->op_type == OP_REQUIRE) {
- CV * const cv = get_cv("DB::postponed", FALSE);
+ CV * const cv = get_cvs("DB::postponed", 0);
if (cv) {
dSP;
PUSHMARK(SP);
register PERL_CONTEXT *cx;
SV *sv;
const I32 gimme = GIMME_V;
- const I32 was = PL_breakable_sub_generation;
+ const U32 was = PL_breakable_sub_gen;
char tbuf[TYPE_DIGITS(long) + 12];
char *tmpbuf = tbuf;
- char *safestr;
STRLEN len;
- bool ok;
CV* runcv;
U32 seq;
HV *saved_hh = NULL;
(i.e. before run-time proper). To work around the coredump that
ensues, we always turn GvMULTI_on for any globals that were
introduced within evals. See force_ident(). GSAR 96-10-12 */
- safestr = savepvn(tmpbuf, len);
- SAVEDELETE(PL_defstash, safestr, len);
SAVEHINTS();
PL_hints = PL_op->op_targ;
if (saved_hh)
if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
PUTBACK;
- ok = doeval(gimme, NULL, runcv, seq);
- if ((PERLDB_LINE || PERLDB_SAVESRC)
- && was != (U32)PL_breakable_sub_generation /* Some subs defined here. */
- && ok) {
- /* Just need to change the string in our writable scratch buffer that
- will be used at scope exit to delete this eval's "file" name, to
- something safe. The key names are of the form "_<(eval 1)" upwards,
- so the 8th char is the first digit, which will not have a leading
- zero. So give it a leading zero, and it can't match anything, but
- still sits within the pattern space "reserved" for evals. */
- safestr[8] = '0';
- }
- return ok ? DOCATCH(PL_eval_start) : PL_op->op_next;
+
+ if (doeval(gimme, NULL, runcv, seq)) {
+ if (was != PL_breakable_sub_gen /* Some subs defined here. */
+ ? (PERLDB_LINE || PERLDB_SAVESRC)
+ : PERLDB_SAVESRC_NOSUBS) {
+ /* Retain the filegv we created. */
+ } else {
+ char *const safestr = savepvn(tmpbuf, len);
+ SAVEDELETE(PL_defstash, safestr, len);
+ }
+ return DOCATCH(PL_eval_start);
+ } else {
+ /* We have already left the scope set up earler thanks to the LEAVE
+ in doeval(). */
+ if (was != PL_breakable_sub_gen /* Some subs defined here. */
+ ? (PERLDB_LINE || PERLDB_SAVESRC)
+ : PERLDB_SAVESRC_INVALID) {
+ /* Retain the filegv we created. */
+ } else {
+ (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD);
+ }
+ return PL_op->op_next;
+ }
}
PP(pp_leaveeval)
SV *This, *Other; /* 'This' (and Other to match) to play with C++ */
REGEXP *this_regex, *other_regex;
-# define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
-
# define SM_REF(type) ( \
(SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_##type) && (Other = e)) \
|| (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_##type) && (Other = d)))
-# define SM_CV_NEP /* Find a code ref without an empty prototype */ \
- ((SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_PVCV) \
- && NOT_EMPTY_PROTO(This) && (Other = e)) \
- || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_PVCV) \
- && NOT_EMPTY_PROTO(This) && (Other = d)))
-
# define SM_REGEX ( \
(SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \
&& (this_regex = (REGEXP*) This) \
&& (this_regex = (REGEXP*) This) \
&& (Other = d)) )
-
-# define SM_OBJECT ( \
- (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) \
- || \
- (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) ) \
-
# define SM_OTHER_REF(type) \
(SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
sv_2mortal(newSViv(PTR2IV(sv))), 0)
tryAMAGICbinSET(smart, 0);
-
+
SP -= 2; /* Pop the values */
/* Take care only to invoke mg_get() once for each argument.
if (SvGMAGICAL(e))
e = sv_mortalcopy(e);
- if (SM_OBJECT)
+ if (!SvOK(e)) {
+ if (SvOK(d))
+ RETPUSHNO;
+ else
+ RETPUSHYES;
+ }
+
+ if ((sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))
+ || (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)))
Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
- if (SM_CV_NEP) {
+ if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) {
I32 c;
-
- if ( SM_OTHER_REF(PVCV) && NOT_EMPTY_PROTO(SvRV(Other)) )
- {
- if (This == SvRV(Other))
+ if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) {
+ /* Test sub truth for each key */
+ HE *he;
+ bool andedresults = TRUE;
+ HV *hv = (HV*) SvRV(d);
+ (void) hv_iterinit(hv);
+ while ( (he = hv_iternext(hv)) ) {
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ PUSHs(hv_iterkeysv(he));
+ PUTBACK;
+ c = call_sv(e, G_SCALAR);
+ SPAGAIN;
+ if (c == 0)
+ andedresults = FALSE;
+ else
+ andedresults = SvTRUEx(POPs) && andedresults;
+ FREETMPS;
+ LEAVE;
+ }
+ if (andedresults)
RETPUSHYES;
else
RETPUSHNO;
}
-
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- PUSHs(Other);
- PUTBACK;
- c = call_sv(This, G_SCALAR);
- SPAGAIN;
- if (c == 0)
- PUSHs(&PL_sv_no);
- else if (SvTEMP(TOPs))
- SvREFCNT_inc_void(TOPs);
- FREETMPS;
- LEAVE;
- RETURN;
+ else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) {
+ /* Test sub truth for each element */
+ I32 i;
+ bool andedresults = TRUE;
+ AV *av = (AV*) SvRV(d);
+ const I32 len = av_len(av);
+ for (i = 0; i <= len; ++i) {
+ SV * const * const svp = av_fetch(av, i, FALSE);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ if (svp)
+ PUSHs(*svp);
+ PUTBACK;
+ c = call_sv(e, G_SCALAR);
+ SPAGAIN;
+ if (c == 0)
+ andedresults = FALSE;
+ else
+ andedresults = SvTRUEx(POPs) && andedresults;
+ FREETMPS;
+ LEAVE;
+ }
+ if (andedresults)
+ RETPUSHYES;
+ else
+ RETPUSHNO;
+ }
+ else {
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ PUSHs(d);
+ PUTBACK;
+ c = call_sv(e, G_SCALAR);
+ SPAGAIN;
+ if (c == 0)
+ PUSHs(&PL_sv_no);
+ else if (SvTEMP(TOPs))
+ SvREFCNT_inc_void(TOPs);
+ FREETMPS;
+ LEAVE;
+ RETURN;
+ }
}
else if (SM_REF(PVHV)) {
if (SM_OTHER_REF(PVHV)) {
RETPUSHNO;
}
}
- else if (!SvOK(d) || !SvOK(e)) {
- if (!SvOK(d) && !SvOK(e))
- RETPUSHYES;
- else
- RETPUSHNO;
- }
else if (SM_REGEX) {
PMOP * const matcher = make_matcher(this_regex);
destroy_matcher(matcher);
RETURN;
}
- else if (SM_REF(PVCV)) {
- I32 c;
- /* This must be a null-prototyped sub, because we
- already checked for the other kind. */
-
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- PUTBACK;
- c = call_sv(This, G_SCALAR);
- SPAGAIN;
- if (c == 0)
- PUSHs(&PL_sv_undef);
- else if (SvTEMP(TOPs))
- SvREFCNT_inc_void(TOPs);
-
- if (SM_OTHER_REF(PVCV)) {
- /* This one has to be null-proto'd too.
- Call both of 'em, and compare the results */
- PUSHMARK(SP);
- c = call_sv(SvRV(Other), G_SCALAR);
- SPAGAIN;
- if (c == 0)
- PUSHs(&PL_sv_undef);
- else if (SvTEMP(TOPs))
- SvREFCNT_inc_void(TOPs);
- FREETMPS;
- LEAVE;
- PUTBACK;
- return pp_eq();
- }
-
- FREETMPS;
- LEAVE;
- RETURN;
- }
else if ( ((SvIOK(d) || SvNOK(d)) && (This = d) && (Other = e))
|| ((SvIOK(e) || SvNOK(e)) && (This = e) && (Other = d)) )
{
projects / p5sagit/p5-mst-13.2.git / blobdiff