This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade CPAN-Meta-YAML from version 0.014 to 0.016
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 6801816..242ea87 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -39,7 +39,7 @@ Perl stores its global variables.
 #include "feature.h"
 
 static const char S_autoload[] = "AUTOLOAD";
-static const STRLEN S_autolen = sizeof(S_autoload)-1;
+#define S_autolen (sizeof("AUTOLOAD")-1)
 
 GV *
 Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
@@ -155,7 +155,7 @@ Perl_gv_const_sv(pTHX_ GV *gv)
 
     if (SvTYPE(gv) == SVt_PVGV)
        return cv_const_sv(GvCVu(gv));
-    return SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVAV ? SvRV(gv) : NULL;
+    return SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVAV && SvTYPE(SvRV(gv)) != SVt_PVCV ? SvRV(gv) : NULL;
 }
 
 GP *
@@ -1984,13 +1984,11 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
            {
                /* Ensures that we have an all-digit variable, ${"1foo"} fails
                   this test  */
-               /* This snippet is taken from is_gv_magical */
-               const char *end = name + len;
-               while (--end > name) {
-                   if (!isDIGIT(*end))
-                        return addmg;
-               }
-                paren = grok_atou(name, NULL);
+                UV uv;
+                if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX)
+                    return addmg;
+                /* XXX why are we using a SSize_t? */
+                paren = (SSize_t)(I32)uv;
                 goto storeparen;
            }
            }
@@ -2540,9 +2538,12 @@ Perl_gp_free(pTHX_ GV *gv)
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
         const HEK *hvname_hek = HvNAME_HEK(hv);
-        DEBUG_o(Perl_deb(aTHX_ "gp_free clearing PL_stashcache for '%"HEKf"'\n", HEKfARG(hvname_hek)));
-        if (PL_stashcache && hvname_hek)
+        if (PL_stashcache && hvname_hek) {
+           DEBUG_o(Perl_deb(aTHX_
+                          "gp_free clearing PL_stashcache for '%"HEKf"'\n",
+                           HEKfARG(hvname_hek)));
            (void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
+        }
        SvREFCNT_dec(hv);
       }
       if (io && SvREFCNT(io) == 1 && IoIFP(io)
@@ -2842,7 +2843,9 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
     SvGETMAGIC(arg);
 
     if (SvAMAGIC(arg) && (tmpsv = amagic_call(arg, &PL_sv_undef, method,
-                                             AMGf_noright | AMGf_unary))) {
+                                             AMGf_noright | AMGf_unary
+                                           | (flags & AMGf_numarg))))
+    {
        if (flags & AMGf_set) {
            SETs(tmpsv);
        }
@@ -2887,7 +2890,8 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
        SV * const tmpsv = amagic_call(left, right, method,
-                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0));
+                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+                 | (flags & AMGf_numarg));
        if (tmpsv) {
            if (flags & AMGf_set) {
                (void)POPs;
@@ -3266,6 +3270,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     case band_amg:
     case bor_amg:
     case bxor_amg:
+    case sband_amg:
+    case sbor_amg:
+    case sbxor_amg:
       if (assign)
         force_scalar = 1;
       break;
@@ -3392,6 +3399,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift),
                           AMG_id2namelen(method + assignshift), SVs_TEMP));
     }
+    else if (flags & AMGf_numarg)
+      PUSHs(&PL_sv_undef);
+    if (flags & AMGf_numarg)
+      PUSHs(&PL_sv_yes);
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
     oldmark = TOPMARK;
@@ -3595,11 +3606,5 @@ core_xsub(pTHX_ CV* cv)
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */