Update the perldelta for ExtUtils::Constant.

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index ab43177..9f62066 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1219,6 +1219,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
            }
+           else if (len == 3 && sv_type == SVt_PVAV
+                 && strnEQ(name, "ISA", 3)
+                 && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
+               gv_magicalize_isa(gv);
        }
        return gv;
     } else if (no_init) {
@@ -1349,6 +1353,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (strEQ(name2, "NCODING"))
                    goto magicalize;
                break;
+           case '\007':        /* $^GLOBAL_PHASE */
+               if (strEQ(name2, "LOBAL_PHASE"))
+                   goto ro_magicalize;
+               break;
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
@@ -1358,7 +1366,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                break;
            case '\020':        /* $^PREMATCH  $^POSTMATCH */
                if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH"))
-                   goto magicalize;  
+                   goto magicalize;
+               break;
            case '\024':        /* ${^TAINT} */
                if (strEQ(name2, "AINT"))
                    goto ro_magicalize;
@@ -1934,7 +1943,8 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
 
     SvGETMAGIC(arg);
 
-    if (SvAMAGIC(arg) && (tmpsv = AMG_CALLun_var(arg,method))) {
+    if (SvAMAGIC(arg) && (tmpsv = amagic_call(arg, &PL_sv_undef, method,
+                                             AMGf_noright | AMGf_unary))) {
        if (flags & AMGf_set) {
            SETs(tmpsv);
        }
@@ -2009,6 +2019,25 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
     return FALSE;
 }
 
+SV *
+Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
+    SV *tmpsv = NULL;
+
+    PERL_ARGS_ASSERT_AMAGIC_DEREF_CALL;
+
+    while (SvAMAGIC(ref) && 
+          (tmpsv = amagic_call(ref, &PL_sv_undef, method,
+                               AMGf_noright | AMGf_unary))) { 
+       if (!SvROK(tmpsv))
+           Perl_croak(aTHX_ "Overloaded dereference did not return a reference");
+       if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) {
+           /* Bail out if it returns us the same reference.  */
+           return tmpsv;
+       }
+       ref = tmpsv;
+    }
+    return tmpsv ? tmpsv : ref;
+}
 
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
@@ -2312,7 +2341,15 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        && (assign || (method == inc_amg) || (method == dec_amg)))
       || force_cpy)
   {
-    RvDEEPCP(left);
+      /* newSVsv does not behave as advertised, so we copy missing
+       * information by hand */
+      SV *tmpRef = SvRV(left);
+      SV *rv_copy;
+      if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLun(left,copy))) {
+         SvRV_set(left, rv_copy);
+         SvSETMAGIC(left);
+         SvREFCNT_dec(tmpRef);  
+      }
   }
 
   {
@@ -2591,7 +2628,7 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
 
     /* XXX Why and where does this leave dangling pointers during global
        destruction? */
-    if (PL_dirty) return;
+    if (PL_phase == PERL_PHASE_DESTRUCT) return;
 
     if (!(SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) &&
            !SvOBJECT(gv) && !SvREADONLY(gv) &&