Instead of a const char *, pass a HEK * to anonymise_cv().
Nicholas Clark [Mon, 22 Jun 2009 19:45:23 +0000 (20:45 +0100)]
This will cope properly with Unicode package names. It also allows use of more
efficient perl API calls, avoiding any strlen()s.

embed.fnc
hv.c
proto.h

index ae5c9f6..3ff1b89 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1354,7 +1354,7 @@ paRxo     |void*  |get_arena      |const size_t svtype|const U32 misc
 #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT)
 s      |void   |hsplit         |NN HV *hv
 s      |void   |hfreeentries   |NN HV *hv
-s      |I32    |anonymise_cv   |NULLOK const char *stash|NN SV *val
+s      |I32    |anonymise_cv   |NULLOK HEK *stash|NN SV *val
 sa     |HE*    |new_he
 sanR   |HEK*   |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags
 sn     |void   |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store
diff --git a/hv.c b/hv.c
index 8d1c6a9..a5221a8 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1468,7 +1468,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return;
     val = HeVAL(entry);
-    if (HvNAME(hv) && anonymise_cv(HvNAME(hv), val) && GvCVu(val))
+    if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val))
        mro_method_changed_in(hv);
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1483,7 +1483,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 }
 
 static I32
-S_anonymise_cv(pTHX_ const char *stash, SV *val)
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
 {
     CV *cv;
 
@@ -1491,12 +1491,17 @@ S_anonymise_cv(pTHX_ const char *stash, SV *val)
 
     if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
        if ((SV *)CvGV(cv) == val) {
-           SV *gvname;
            GV *anongv;
 
-           gvname = Perl_newSVpvf(aTHX_ "%s::__ANON__", stash ? stash : "__ANON__");
-           anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
-           SvREFCNT_dec(gvname);
+           if (stash) {
+               SV *gvname = newSVhek(stash);
+               sv_catpvs(gvname, "::__ANON__");
+               anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
+               SvREFCNT_dec(gvname);
+           } else {
+               anongv = gv_fetchpvs("__ANON__::__ANON__", GV_ADDMULTI,
+                                    SVt_PVCV);
+           }
            CvGV(cv) = anongv;
            CvANON_on(cv);
            return 1;
diff --git a/proto.h b/proto.h
index fc06fb1..427600e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4254,7 +4254,7 @@ STATIC void       S_hfreeentries(pTHX_ HV *hv)
 #define PERL_ARGS_ASSERT_HFREEENTRIES  \
        assert(hv)
 
-STATIC I32     S_anonymise_cv(pTHX_ const char *stash, SV *val)
+STATIC I32     S_anonymise_cv(pTHX_ HEK *stash, SV *val)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_ANONYMISE_CV  \
        assert(val)