This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade Unicode::Normalize from version 1.17 to 1.18
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index baf9804..e402f6b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2263,7 +2263,6 @@ Perl_gv_check(pTHX_ HV *stash)
 {
     dVAR;
     I32 i;
-    struct xpvhv_aux *aux;
 
     PERL_ARGS_ASSERT_GV_CHECK;
 
@@ -2271,12 +2270,11 @@ Perl_gv_check(pTHX_ HV *stash)
        return;
 
     assert(SvOOK(stash));
-    aux = HvAUX(stash);
 
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
         /* mark stash is being scanned, to avoid recursing */
-        aux->xhv_aux_flags |= HvAUXf_SCAN_STASH;
+        HvAUX(stash)->xhv_aux_flags |= HvAUXf_SCAN_STASH;
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
             GV *gv;
             HV *hv;
@@ -2310,7 +2308,7 @@ Perl_gv_check(pTHX_ HV *stash)
                             HEKfARG(GvNAME_HEK(gv)));
            }
        }
-        aux->xhv_aux_flags &= ~HvAUXf_SCAN_STASH;
+        HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_SCAN_STASH;
     }
 }
 
@@ -2493,6 +2491,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
   {
     int filled = 0;
     int i;
+    bool deref_seen = 0;
+
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
 
@@ -2523,6 +2523,10 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
         filled = 1;
     }
 
+    assert(SvOOK(stash));
+    /* initially assume the worst */
+    HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
+
     for (i = 1; i < NofAMmeth; i++) {
        const char * const cooky = PL_AMG_names[i];
        /* Human-readable form, for debugging: */
@@ -2589,7 +2593,26 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
            filled = 1;
        }
        amt.table[i]=MUTABLE_CV(SvREFCNT_inc_simple(cv));
+
+        if (gv) {
+            switch (i) {
+            case to_sv_amg:
+            case to_av_amg:
+            case to_hv_amg:
+            case to_gv_amg:
+            case to_cv_amg:
+            case nomethod_amg:
+                deref_seen = 1;
+                break;
+            }
+        }
     }
+    if (!deref_seen)
+        /* none of @{} etc overloaded; we can do $obj->[N] quicker.
+         * NB - aux var invalid here, HvARRAY() could have been
+         * reallocated since it was assigned to */
+        HvAUX(stash)->xhv_aux_flags |= HvAUXf_NO_DEREF;
+
     if (filled) {
       AMT_AMAGIC_on(&amt);
       sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table,
@@ -2759,11 +2782,19 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
 SV *
 Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
     SV *tmpsv = NULL;
+    HV *stash;
 
     PERL_ARGS_ASSERT_AMAGIC_DEREF_CALL;
 
-    while (SvAMAGIC(ref) && 
-          (tmpsv = amagic_call(ref, &PL_sv_undef, method,
+    if (!SvAMAGIC(ref))
+        return ref;
+    /* return quickly if none of the deref ops are overloaded */
+    stash = SvSTASH(SvRV(ref));
+    assert(SvOOK(stash));
+    if (HvAUX(stash)->xhv_aux_flags & HvAUXf_NO_DEREF)
+        return ref;
+
+    while ((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");
@@ -2772,6 +2803,8 @@ Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
            return tmpsv;
        }
        ref = tmpsv;
+        if (!SvAMAGIC(ref))
+            break;
     }
     return tmpsv ? tmpsv : ref;
 }