Unicode::UCD: white-space only

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 5926874..cbdcb90 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -771,10 +771,10 @@ PP(pp_rv2av)
     if (SvROK(sv)) {
        if (SvAMAGIC(sv)) {
            sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
-           SPAGAIN;
        }
        sv = SvRV(sv);
        if (SvTYPE(sv) != type)
+           /* diag_listed_as: Not an ARRAY reference */
            DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
        if (PL_op->op_flags & OPf_REF) {
            SETs(sv);
@@ -1615,12 +1615,12 @@ Perl_do_readline(pTHX)
            mg_get(sv);
        if (SvROK(sv)) {
            if (type == OP_RCATLINE)
-               SvPV_force_nolen(sv);
+               SvPV_force_nomg_nolen(sv);
            else
                sv_unref(sv);
        }
        else if (isGV_with_GP(sv)) {
-           SvPV_force_nolen(sv);
+           SvPV_force_nomg_nolen(sv);
        }
        SvUPGRADE(sv, SVt_PV);
        tmplen = SvLEN(sv);     /* remember if already alloced */
@@ -1633,7 +1633,7 @@ Perl_do_readline(pTHX)
        offset = 0;
        if (type == OP_RCATLINE && SvOK(sv)) {
            if (!SvPOK(sv)) {
-               SvPV_force_nolen(sv);
+               SvPV_force_nomg_nolen(sv);
            }
            offset = SvCUR(sv);
        }
@@ -1774,7 +1774,7 @@ PP(pp_helem)
     he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
     svp = he ? &HeVAL(he) : NULL;
     if (lval) {
-       if (!svp || *svp == &PL_sv_undef) {
+       if (!svp || !*svp || *svp == &PL_sv_undef) {
            SV* lv;
            SV* key2;
            if (!defer) {
@@ -1804,7 +1804,7 @@ PP(pp_helem)
            RETURN;
        }
     }
-    sv = (svp ? *svp : &PL_sv_undef);
+    sv = (svp && *svp ? *svp : &PL_sv_undef);
     /* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
      * was to make C<local $tied{foo} = $tied{foo}> possible.
      * However, it seems no longer to be needed for that purpose, and
@@ -1964,7 +1964,7 @@ PP(pp_iter)
 /*
 A description of how taint works in pattern matching and substitution.
 
-While the pattern is being assembled/concatenated and them compiled,
+While the pattern is being assembled/concatenated and then compiled,
 PL_tainted will get set if any component of the pattern is tainted, e.g.
 /.*$tainted/.  At the end of pattern compilation, the RXf_TAINTED flag
 is set on the pattern if PL_tainted is set.
@@ -2549,8 +2549,6 @@ PP(pp_entersub)
     switch (SvTYPE(sv)) {
        /* This is overwhelming the most common case:  */
     case SVt_PVGV:
-       if (!isGV_with_GP(sv))
-           DIE(aTHX_ "Not a CODE reference");
       we_have_a_glob:
        if (!(cv = GvCVu((const GV *)sv))) {
            HV *stash;
@@ -2587,7 +2585,7 @@ PP(pp_entersub)
            if (!sym)
                DIE(aTHX_ PL_no_usym, "a subroutine");
            if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(aTHX_ "Can't use string (\"%.32s\"%s) as a subroutine ref while \"strict refs\" in use", sym, len>32 ? "..." : "");
+               DIE(aTHX_ "Can't use string (\"%" SVf32 "\"%s) as a subroutine ref while \"strict refs\" in use", sv, len>32 ? "..." : "");
            cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
            break;
        }
@@ -2717,6 +2715,9 @@ try_autoload:
                MARK++;
            }
        }
+       if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
+           !CvLVALUE(cv))
+           DIE(aTHX_ "Can't modify non-lvalue subroutine call");
        /* warning must come *after* we fully set up the context
         * stuff so that __WARN__ handlers can safely dounwind()
         * if they want to
@@ -2976,9 +2977,10 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
            if (!packname ||
                ((UTF8_IS_START(*packname) && DO_UTF8(sv))
                    ? !isIDFIRST_utf8((U8*)packname)
-                   : !isIDFIRST(*packname)
+                   : !isIDFIRST_L1((U8)*packname)
                ))
            {
+               /* diag_listed_as: Can't call method "%s" without a package or object reference */
                Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
                           SVfARG(meth),
                           SvOK(sv) ? "without a package or object reference"
@@ -2991,7 +2993,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
             else {
                SV* const ref = newSViv(PTR2IV(stash));
                (void)hv_store(PL_stashcache, packname,
-                                packname_is_utf8 ? -packlen : packlen, ref, 0);
+                                packname_is_utf8 ? -(I32)packlen : (I32)packlen, ref, 0);
            }
            goto fetch;
        }
@@ -3006,10 +3008,10 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
                     && (ob = MUTABLE_SV(GvIO((const GV *)ob)))
                     && SvOBJECT(ob))))
     {
-       const char * const name = SvPV_nolen_const(meth);
-       Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
-                  (SvSCREAM(meth) && strEQ(name,"isa")) ? "DOES" :
-                  name);
+       Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference",
+                  SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa"))
+                                        ? newSVpvs_flags("DOES", SVs_TEMP)
+                                        : meth));
     }
 
     stash = SvSTASH(ob);