APItest: Test native code points, instead of Unicode

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index b66eced..d3527aa 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -165,7 +165,7 @@ Perl_newGP(pTHX_ GV *const gv)
     const char *file;
     STRLEN len;
 #ifndef USE_ITHREADS
-    SV * temp_sv;
+    GV *filegv;
 #endif
     dVAR;
 
@@ -176,13 +176,23 @@ Perl_newGP(pTHX_ GV *const gv)
     gp->gp_sv = newSV(0);
 #endif
 
-#ifdef USE_ITHREADS
+    /* PL_curcop should never be null here. */
+    assert(PL_curcop);
+    /* But for non-debugging builds play it safe */
     if (PL_curcop) {
        gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+#ifdef USE_ITHREADS
        if (CopFILE(PL_curcop)) {
            file = CopFILE(PL_curcop);
            len = strlen(file);
        }
+#else
+       filegv = CopFILEGV(PL_curcop);
+       if (filegv) {
+           file = GvNAME(filegv)+2;
+           len = GvNAMELEN(filegv)-2;
+       }
+#endif
        else goto no_file;
     }
     else {
@@ -190,18 +200,6 @@ Perl_newGP(pTHX_ GV *const gv)
        file = "";
        len = 0;
     }
-#else
-    if(PL_curcop)
-       gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
-    temp_sv = CopFILESV(PL_curcop);
-    if (temp_sv) {
-       file = SvPVX(temp_sv);
-       len = SvCUR(temp_sv);
-    } else {
-       file = "";
-       len = 0;
-    }
-#endif
 
     PERL_HASH(hash, file, len);
     gp->gp_file_hek = share_hek(file, len, hash);
@@ -683,8 +681,9 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
     if (flags & GV_SUPER) {
-       if (!HvAUX(stash)->xhv_super) HvAUX(stash)->xhv_super = newHV();
-       cachestash = HvAUX(stash)->xhv_super;
+       if (!HvAUX(stash)->xhv_mro_meta->super)
+           HvAUX(stash)->xhv_mro_meta->super = newHV();
+       cachestash = HvAUX(stash)->xhv_mro_meta->super;
     }
     else cachestash = stash;
 
@@ -1824,6 +1823,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             case '\015':        /* $^MATCH */
                 if (strEQ(name2, "ATCH"))
                    goto magicalize;
+                break;
            case '\017':        /* $^OPEN */
                if (strEQ(name2, "PEN"))
                    goto magicalize;
@@ -2074,7 +2074,7 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain
 }
 
 void
-Perl_gv_check(pTHX_ const HV *stash)
+Perl_gv_check(pTHX_ HV *stash)
 {
     dVAR;
     I32 i;
@@ -2085,13 +2085,16 @@ Perl_gv_check(pTHX_ const HV *stash)
        return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
+       /* SvIsCOW is unused on HVs, so we can use it to mark stashes we
+          are currently searching through recursively.  */
+       SvIsCOW_on(stash);
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
             GV *gv;
             HV *hv;
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
                (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv)))
            {
-               if (hv != PL_defstash && hv != stash)
+               if (hv != PL_defstash && hv != stash && !SvIsCOW(hv))
                     gv_check(hv);              /* nested package */
            }
             else if ( *HeKEY(entry) != '_'
@@ -2102,9 +2105,12 @@ Perl_gv_check(pTHX_ const HV *stash)
                    continue;
                file = GvFILE(gv);
                CopLINE_set(PL_curcop, GvLINE(gv));
-               /* set file name for warning */
-               CopFILE_setn(PL_curcop, file, HEK_LEN(GvFILE_HEK(gv)));
-               SvREFCNT_dec(CopFILEGV(PL_curcop));
+#ifdef USE_ITHREADS
+               CopFILE(PL_curcop) = (char *)file;      /* set for warning */
+#else
+               CopFILEGV(PL_curcop)
+                   = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
+#endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
                        "Name \"%"HEKf"::%"HEKf
                        "\" used only once: possible typo",
@@ -2112,6 +2118,7 @@ Perl_gv_check(pTHX_ const HV *stash)
                             HEKfARG(GvNAME_HEK(gv)));
            }
        }
+       SvIsCOW_off(stash);
     }
 }