X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=a7f1b762216a5264b7ab9508859cd6bc0bb1ea9e;hb=16fb65535f1212ccde424817ffed1c1fc155b039;hp=46636f787f850734827fbf6da88d7b9d137aade0;hpb=015eb7b967ac690ef0b530c0aa564f080ff0fa4b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 46636f7..a7f1b76 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3668,8 +3668,11 @@ PP(pp_entereval) introduced within evals. See force_ident(). GSAR 96-10-12 */ SAVEHINTS(); PL_hints = PL_op->op_targ; - if (saved_hh) + if (saved_hh) { + /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */ + SvREFCNT_dec(GvHV(PL_hintgv)); GvHV(PL_hintgv) = saved_hh; + } SAVECOMPILEWARNINGS(); PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); if (PL_compiling.cop_hints_hash) { @@ -3997,9 +4000,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) dVAR; dSP; + bool object_on_left = FALSE; SV *e = TOPs; /* e is for 'expression' */ SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */ + /* First of all, handle overload magic of the rightmost argument */ if (SvAMAGIC(e)) { SV * const tmpsv = amagic_call(d, e, smart_amg, 0); if (tmpsv) { @@ -4035,11 +4040,16 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); + if (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) + object_on_left = TRUE; /* ~~ sub */ if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) { I32 c; - if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + if (object_on_left) { + goto sm_any_sub; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { /* Test sub truth for each key */ HE *he; bool andedresults = TRUE; @@ -4098,6 +4108,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } else { + sm_any_sub: ENTER; SAVETMPS; PUSHMARK(SP); @@ -4116,7 +4127,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } /* ~~ %hash */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) { - if (!SvOK(d)) { + if (object_on_left) { + goto sm_any_hash; /* Treat objects like scalars */ + } + else if (!SvOK(d)) { RETPUSHNO; } else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { @@ -4149,12 +4163,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) to check that one is a subset of the other. */ (void) hv_iterinit(hv); while ( (he = hv_iternext(hv)) ) { - I32 key_len; - char * const key = hv_iterkey(he, &key_len); + SV *key = hv_iterkeysv(he); ++ this_key_count; - if(!hv_exists(other_hv, key, key_len)) { + if(!hv_exists_ent(other_hv, key, 0)) { (void) hv_iterinit(hv); /* reset iterator */ RETPUSHNO; } @@ -4181,34 +4194,34 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) for (i = 0; i < other_len; ++i) { SV ** const svp = av_fetch(other_av, i, FALSE); - char *key; - STRLEN key_len; - if (svp) { /* ??? When can this not happen? */ - key = SvPV(*svp, key_len); - if (hv_exists(hv, key, key_len)) + if (hv_exists_ent(hv, *svp, 0)) RETPUSHYES; } } RETPUSHNO; } else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); - HE *he; - HV *hv = MUTABLE_HV(SvRV(e)); - - (void) hv_iterinit(hv); - while ( (he = hv_iternext(hv)) ) { - if (matcher_matches_sv(matcher, hv_iterkeysv(he))) { - (void) hv_iterinit(hv); - destroy_matcher(matcher); - RETPUSHYES; + sm_regex_hash: + { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); + HE *he; + HV *hv = MUTABLE_HV(SvRV(e)); + + (void) hv_iterinit(hv); + while ( (he = hv_iternext(hv)) ) { + if (matcher_matches_sv(matcher, hv_iterkeysv(he))) { + (void) hv_iterinit(hv); + destroy_matcher(matcher); + RETPUSHYES; + } } + destroy_matcher(matcher); + RETPUSHNO; } - destroy_matcher(matcher); - RETPUSHNO; } else { + sm_any_hash: if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0)) RETPUSHYES; else @@ -4217,19 +4230,18 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } /* ~~ @array */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) { - if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + if (object_on_left) { + goto sm_any_array; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { AV * const other_av = MUTABLE_AV(SvRV(e)); const I32 other_len = av_len(other_av) + 1; I32 i; for (i = 0; i < other_len; ++i) { SV ** const svp = av_fetch(other_av, i, FALSE); - char *key; - STRLEN key_len; - if (svp) { /* ??? When can this not happen? */ - key = SvPV(*svp, key_len); - if (hv_exists(MUTABLE_HV(SvRV(d)), key, key_len)) + if (hv_exists_ent(MUTABLE_HV(SvRV(d)), *svp, 0)) RETPUSHYES; } } @@ -4289,19 +4301,22 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) } } else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); - const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); - I32 i; - - for(i = 0; i <= this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - if (svp && matcher_matches_sv(matcher, *svp)) { - destroy_matcher(matcher); - RETPUSHYES; + sm_regex_array: + { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); + I32 i; + + for(i = 0; i <= this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + if (svp && matcher_matches_sv(matcher, *svp)) { + destroy_matcher(matcher); + RETPUSHYES; + } } + destroy_matcher(matcher); + RETPUSHNO; } - destroy_matcher(matcher); - RETPUSHNO; } else if (!SvOK(d)) { /* undef ~~ array */ @@ -4316,40 +4331,69 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) RETPUSHNO; } else { - const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); - I32 i; + sm_any_array: + { + I32 i; + const I32 this_len = av_len(MUTABLE_AV(SvRV(e))); - for(i = 0; i <= this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - if (!svp) - continue; + for (i = 0; i <= this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + if (!svp) + continue; - PUSHs(d); - PUSHs(*svp); - PUTBACK; - /* infinite recursion isn't supposed to happen here */ - (void) do_smartmatch(NULL, NULL); - SPAGAIN; - if (SvTRUEx(POPs)) - RETPUSHYES; + PUSHs(d); + PUSHs(*svp); + PUTBACK; + /* infinite recursion isn't supposed to happen here */ + (void) do_smartmatch(NULL, NULL); + SPAGAIN; + if (SvTRUEx(POPs)) + RETPUSHYES; + } + RETPUSHNO; } - RETPUSHNO; } } /* ~~ qr// */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_REGEXP) { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(e)); + if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + SV *t = d; d = e; e = t; + goto sm_regex_hash; + } + else if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + SV *t = d; d = e; e = t; + goto sm_regex_array; + } + else { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(e)); - PUTBACK; - PUSHs(matcher_matches_sv(matcher, d) - ? &PL_sv_yes - : &PL_sv_no); - destroy_matcher(matcher); - RETURN; + PUTBACK; + PUSHs(matcher_matches_sv(matcher, d) + ? &PL_sv_yes + : &PL_sv_no); + destroy_matcher(matcher); + RETURN; + } } - /* ~~ X..Y TODO */ /* ~~ scalar */ - else if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { + /* See if there is overload magic on left */ + else if (object_on_left && SvAMAGIC(d)) { + SV *tmpsv; + PUSHs(d); PUSHs(e); + PUTBACK; + tmpsv = amagic_call(d, e, smart_amg, AMGf_noright); + if (tmpsv) { + SPAGAIN; + (void)POPs; + SETs(tmpsv); + RETURN; + } + SP -= 2; + goto sm_any_scalar; + } + else + sm_any_scalar: + if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { /* numeric comparison */ PUSHs(d); PUSHs(e); PUTBACK; @@ -4902,8 +4946,16 @@ S_path_is_absolute(const char *name) PERL_ARGS_ASSERT_PATH_IS_ABSOLUTE; if (PERL_FILE_IS_ABSOLUTE(name) +#ifdef WIN32 + || (*name == '.' && ((name[1] == '/' || + (name[1] == '.' && name[2] == '/')) + || (name[1] == '\\' || + ( name[1] == '.' && name[2] == '\\'))) + ) +#else || (*name == '.' && (name[1] == '/' || (name[1] == '.' && name[2] == '/'))) +#endif ) { return TRUE;