In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ce2dc92abf80d6caafee908b59bd4395d671f3c9?hp=ee39f343efffd64e53e2d8282afa1cb99a1b7dcd>
- Log ----------------------------------------------------------------- commit ce2dc92abf80d6caafee908b59bd4395d671f3c9 Author: Father Chrysostomos <[email protected]> Date: Tue Jun 5 20:13:21 2012 -0700 pending-author.t: Skip for lack of config That âgit config --get user.emailâ will output something is a big assumption. M t/porting/pending-author.t commit 99225839922929466cd6a5c5254e0ca689af2ac3 Author: Father Chrysostomos <[email protected]> Date: Tue Jun 5 16:31:31 2012 -0700 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. M ext/B/B.xs M ext/B/t/b.t commit 9343f4cf23ede11b197fea9daa9ed32154bf1271 Author: Father Chrysostomos <[email protected]> Date: Tue Jun 5 16:06:34 2012 -0700 stash.t: 2 TODO tests I missed M t/op/stash.t M t/uni/stash.t commit b07450211dd1f1494ceebcfe2758951f54902269 Author: Father Chrysostomos <[email protected]> Date: Tue Jun 5 16:03:47 2012 -0700 Fix version logic in B.xs M ext/B/B.xs commit a60c099b83a336be6df44b89eb468b0cdfe351ca Author: Father Chrysostomos <[email protected]> Date: Tue Jun 5 14:41:25 2012 -0700 Change B::COP::stashlen to stashoff This was brought up in ticket #78742. The stashlen method has never been in a stable release, and no longer exists, as of d4d03940c, since it is dependent on a define that d4d03940c removed. So this commit removes stashlen from B.xs and adds stashoff in its place, since this is what B::C needs. It also adds a few basic tests for the stash and stashpv methods. M ext/B/B.pm M ext/B/B.xs M ext/B/t/b.t ----------------------------------------------------------------------- Summary of changes: ext/B/B.pm | 2 +- ext/B/B.xs | 39 ++++++++++++++++++++++++++------------- ext/B/t/b.t | 14 ++++++++++++++ t/op/stash.t | 5 +---- t/porting/pending-author.t | 4 +--- t/uni/stash.t | 5 +---- 6 files changed, 44 insertions(+), 25 deletions(-) diff --git a/ext/B/B.pm b/ext/B/B.pm index d7a5cdf..1dcaf99 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -1213,7 +1213,7 @@ Only when perl was compiled with ithreads. =item stashpv -=item stashlen +=item stashoff (threaded only) =item file diff --git a/ext/B/B.xs b/ext/B/B.xs index 69fc6bb..9afc500 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -885,6 +885,7 @@ threadsv_names() #ifdef USE_ITHREADS #define COP_stashpv_ix char_pp | offsetof(struct cop, cop_stashpv) +#define COP_stashoff_ix PADOFFSETp | offsetof(struct cop, cop_stashoff) #define COP_file_ix char_pp | offsetof(struct cop, cop_file) #else #define COP_stash_ix SVp | offsetof(struct cop, cop_stash) @@ -1163,12 +1164,15 @@ BOOT: #ifdef USE_ITHREADS cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__); XSANY.any_i32 = PMOP_pmoffset_ix; -# if PERL_VERSION >= 17 && defined(CopSTASH_len) +# if PERL_VERSION < 17 || defined(CopSTASH_len) cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_stashpv_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; -# endif #else cv = newXS("B::COP::stash", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_stash_ix; @@ -1229,9 +1233,6 @@ pv(o) ST(0) = newSVpvn_flags(o->op_pv, strlen(o->op_pv), SVs_TEMP); #define COP_label(o) CopLABEL(o) -#ifdef CopSTASH_len -#define COP_stashlen(o) CopSTASH_len(o) -#endif MODULE = B PACKAGE = B::COP PREFIX = COP_ @@ -1255,25 +1256,37 @@ COP_stash(o) PUSHs(make_sv_object(aTHX_ ix ? (SV *)CopFILEGV(o) : (SV *)CopSTASH(o))); -#ifdef CopSTASH_len +#else -U32 -COP_stashlen(o) +char * +COP_file(o) B::COP o + CODE: + RETVAL = CopFILE(o); + OUTPUT: + RETVAL #endif -#endif +#if PERL_VERSION >= 10 -#if !defined(USE_ITHREADS) || (PERL_VERSION > 16 && !defined(CopSTASH_len)) +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 2534c27..85e0247 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -295,4 +295,18 @@ foo can_ok $f, 'LINES'; } +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'; + isnt $cop->stashoff, $bobby->stashoff, + 'different COP->stashoff for different stashes'; +} + done_testing(); diff --git a/t/op/stash.t b/t/op/stash.t index 99e44da..616853b 100644 --- a/t/op/stash.t +++ b/t/op/stash.t @@ -294,11 +294,8 @@ fresh_perl_is( 'ref() returns the same thing when an objectâs stash is detached'; ::like "$obj", qr "^rile=ARRAY\(0x[\da-f]+\)\z", 'objects stringify the same way when their stashes are detached'; - { - local $::TODO = $Config{useithreads} ? "fails under threads" : undef; - ::is eval '__PACKAGE__', 'rile', + ::is eval '__PACKAGE__', 'rile', '__PACKAGE__ returns the same when the current stash is detached'; - } } # Setting the name during undef %stash:: should have no effect. diff --git a/t/porting/pending-author.t b/t/porting/pending-author.t index 6bc392b..e6240fb 100644 --- a/t/porting/pending-author.t +++ b/t/porting/pending-author.t @@ -43,9 +43,7 @@ sub get { my $key = shift; my $value = `git config --get user.$key`; unless (defined $value && $value =~ /\S/) { - plan(1); - like($value, qr/\S/, "git config --get user.$key returned a value"); - exit 1; + skip_all("git config --get user.$key returned nought"); } chomp $value; return $value; diff --git a/t/uni/stash.t b/t/uni/stash.t index bacd69d..7d24e51 100644 --- a/t/uni/stash.t +++ b/t/uni/stash.t @@ -280,11 +280,8 @@ plan( tests => 58 ); 'ref() returns the same thing when an objectâs stash is detached'; ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z", 'objects stringify the same way when their stashes are detached'; - { - local $::TODO = $Config{useithreads} ? "fails under threads" : undef; - ::is eval '__PACKAGE__', 'rìle', + ::is eval '__PACKAGE__', 'rìle', '__PACKAGE__ returns the same when the current stash is detached'; - } } # Setting the name during undef %stash:: should have no effect. -- Perl5 Master Repository
