Make B::COP::stashpv respect utf8 and embedded nulls

This was mentioned in ticket #113060.

This commit also adds another stashoff test.

The diff looks a bit complicated, because it stops ->file and
->stashpv from being XS aliases.

diff --git a/ext/B/B.xs b/ext/B/B.xs
index a4c6731..9afc500 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1167,12 +1167,12 @@ BOOT:
 # if PERL_VERSION < 17 || defined(CopSTASH_len)
         cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__);
         XSANY.any_i32 = COP_stashpv_ix;
-        cv = newXS("B::COP::file", XS_B__OP_next, __FILE__);
-        XSANY.any_i32 = COP_file_ix;
 # else
         cv = newXS("B::COP::stashoff", XS_B__OP_next, __FILE__);
         XSANY.any_i32 = COP_stashoff_ix;
 # endif
+        cv = newXS("B::COP::file", XS_B__OP_next, __FILE__);
+        XSANY.any_i32 = COP_file_ix;
 #else
         cv = newXS("B::COP::stash", XS_B__OP_next, __FILE__);
         XSANY.any_i32 = COP_stash_ix;
@@ -1256,17 +1256,37 @@ COP_stash(o)
        PUSHs(make_sv_object(aTHX_
                             ix ? (SV *)CopFILEGV(o) : (SV *)CopSTASH(o)));
 
+#else
+
+char *
+COP_file(o)
+       B::COP  o
+    CODE:
+       RETVAL = CopFILE(o);
+    OUTPUT:
+       RETVAL
+
 #endif
 
-#if !defined(USE_ITHREADS) || (PERL_VERSION > 16 && !defined(CopSTASH_len))
+#if PERL_VERSION >= 10
+
+SV *
+COP_stashpv(o)
+       B::COP  o
+    CODE:
+       RETVAL = CopSTASH(o) && SvTYPE(CopSTASH(o)) == SVt_PVHV
+           ? newSVhek(HvNAME_HEK(CopSTASH(o)))
+           : &PL_sv_undef;
+    OUTPUT:
+       RETVAL
+
+#else
 
 char *
 COP_stashpv(o)
        B::COP  o
-    ALIAS:
-       file = 1
     CODE:
-       RETVAL = ix ? CopFILE(o) : CopSTASHPV(o);
+       RETVAL = CopSTASHPV(o);
     OUTPUT:
        RETVAL
 

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index d046885..85e0247 100644 (file)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -296,11 +296,17 @@ foo
 }
 
 my $sub1 = sub {die};
+{ no warnings 'once'; no strict; *Peel:: = *{"Pe\0e\x{142}::"} }
+my $sub2 = eval 'package Peel; sub {die}';
 my $cop = B::svref_2object($sub1)->ROOT->first->first;
+my $bobby = B::svref_2object($sub2)->ROOT->first->first;
 is $cop->stash->object_2svref, \%main::, 'COP->stash';
 is $cop->stashpv, 'main', 'COP->stashpv';
+is $bobby->stashpv, "Pe\0e\x{142}", 'COP->stashpv with utf8 and nulls';
 if ($Config::Config{useithreads}) {
-    like $cop->stashoff, qr/^[1-9]\d*\z/a, 'COP->stashoff'
+    like $cop->stashoff, qr/^[1-9]\d*\z/a, 'COP->stashoff';
+    isnt $cop->stashoff, $bobby->stashoff,
+       'different COP->stashoff for different stashes';
 }
 
 done_testing();