[PATCH] perlcommunity.pod: add information about OSDC.fr

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index d720b70..80bb590 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -202,7 +202,7 @@ PP(pp_rv2gv)
            }
            else {
                if (PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(aTHX_ PL_no_symref_sv, sv, "a symbol");
+                   DIE(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), "a symbol");
                if ((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
                    == OPpDONT_INIT_GV) {
                    /* We are the target of a coderef assignment.  Return
@@ -232,7 +232,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
 
     if (PL_op->op_private & HINT_STRICT_REFS) {
        if (SvOK(sv))
-           Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+           Perl_die(aTHX_ PL_no_symref_sv, sv, (SvCUR(sv)>32 ? "..." : ""), what);
        else
            Perl_die(aTHX_ PL_no_usym, what);
     }
@@ -321,12 +321,19 @@ PP(pp_av2arylen)
 {
     dVAR; dSP;
     AV * const av = MUTABLE_AV(TOPs);
-    SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
-    if (!*sv) {
-       *sv = newSV_type(SVt_PVMG);
-       sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+    const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+    if (lvalue) {
+       SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+       if (!*sv) {
+           *sv = newSV_type(SVt_PVMG);
+           sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+       }
+       SETs(*sv);
+    } else {
+       SETs(sv_2mortal(newSViv(
+           AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
+       )));
     }
-    SETs(*sv);
     RETURN;
 }
 
@@ -422,6 +429,10 @@ PP(pp_prototype)
                    ret = newSVpvs_flags("_;$", SVs_TEMP);
                    goto set;
                }
+               if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
+                   ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+                   goto set;
+               }
                if (code == -KEY_readpipe) {
                    s = "CORE::backtick";
                }
@@ -5325,6 +5336,24 @@ PP(unimplemented_op)
        PL_op->op_type);
 }
 
+PP(pp_boolkeys)
+{
+    dVAR;
+    dSP;
+    HV * const hv = (HV*)POPs;
+    
+    if (SvRMAGICAL(hv)) {
+       MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+       if (mg) {
+            XPUSHs(magic_scalarpack(hv, mg));
+           RETURN;
+        }          
+    }
+
+    XPUSHs(boolSV(HvKEYS(hv) != 0));
+    RETURN;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd