case CXt_LOOP_LAZYSV:
case CXt_LOOP_FOR:
case CXt_LOOP_PLAIN:
+ case CXt_GIVEN:
+ case CXt_WHEN:
gotoprobe = cx->blk_oldcop->op_sibling;
break;
case CXt_SUBST:
Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
LEAVE;
}
+ /* If a version >= 5.11.0 is requested, strictures are on by default! */
+ if (PL_compcv &&
+ vcmp(sv, sv_2mortal(upg_version(newSVnv(5.011000), FALSE))) >= 0) {
+ PL_hints |= (HINT_STRICT_REFS | HINT_STRICT_SUBS | HINT_STRICT_VARS);
+ }
RETPUSHYES;
}
tryname = SvPVX_const(namesv);
tryrsfp = doopen_pm(tryname, SvCUR(namesv));
if (tryrsfp) {
- if (tryname[0] == '.' && tryname[1] == '/')
- tryname += 2;
+ if (tryname[0] == '.' && tryname[1] == '/') {
+ ++tryname;
+ while (*++tryname == '/');
+ }
break;
}
else if (errno == EMFILE)
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) {
ENTER;
SAVETMPS;
- if (PL_op->op_targ == 0) {
- SV ** const defsv_p = &GvSV(PL_defgv);
- *defsv_p = newSVsv(POPs);
- SAVECLEARSV(*defsv_p);
- }
- else
- sv_setsv(PAD_SV(PL_op->op_targ), POPs);
+ sv_setsv(PAD_SV(PL_op->op_targ), POPs);
PUSHBLOCK(cx, CXt_GIVEN, SP);
PUSHGIVEN(cx);
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) {
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;
}
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;
}
}
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;
}
}
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 if (!SvOK(d)) {
+ /* undef ~~ scalar ; we already know that the scalar is SvOK */
+ RETPUSHNO;
+ }
+ else
+ sm_any_scalar:
+ if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) {
/* numeric comparison */
PUSHs(d); PUSHs(e);
PUTBACK;