diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-09-26 08:53:36 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-09-26 08:55:12 -0700 |
commit | 0be5d18d4f53600db81ddc43c2c98dba5b7869d2 (patch) | |
tree | 99c8de71b21f7be9af0c7b5107f459726efd6de3 /ext | |
parent | 85ffec368212c676791d13ff9743912238325bc2 (diff) | |
download | perl-0be5d18d4f53600db81ddc43c2c98dba5b7869d2.tar.gz |
Test XS registration of state subs
my subs do not currently work yet. I am not sure what the API
should be.
Diffstat (limited to 'ext')
-rw-r--r-- | ext/XS-APItest/APItest.xs | 20 | ||||
-rw-r--r-- | ext/XS-APItest/t/lexsub.t | 19 |
2 files changed, 39 insertions, 0 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 357b033f7f..8c045bcf45 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3431,6 +3431,26 @@ CODE: OUTPUT: RETVAL +void +lexical_import(SV *name, CV *cv) + CODE: + { + PADLIST *pl; + PADOFFSET off; + if (!PL_compcv) + Perl_croak(aTHX_ + "lexical_import can only be called at compile time"); + pl = CvPADLIST(PL_compcv); + ENTER; + SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(pl); + SAVESPTR(PL_comppad); PL_comppad = PadlistARRAY(pl)[1]; + SAVESPTR(PL_curpad); PL_curpad = PadARRAY(PL_comppad); + off = pad_add_name_sv(newSVpvf("&%"SVf,name), padadd_STATE, 0, 0); + SvREFCNT_dec(PL_curpad[off]); + PL_curpad[off] = SvREFCNT_inc(cv); + LEAVE; + } + MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest diff --git a/ext/XS-APItest/t/lexsub.t b/ext/XS-APItest/t/lexsub.t new file mode 100644 index 0000000000..2d66addf7a --- /dev/null +++ b/ext/XS-APItest/t/lexsub.t @@ -0,0 +1,19 @@ +use Test::More tests => 4; +use XS::APItest; + + +sub fribbler { 2*shift } +{ + BEGIN { lexical_import fribbler => sub { 3*shift } } + is fribbler(15), 45, 'lexical subs via pad_add_name'; +} +is fribbler(15), 30, 'XS-allocated lexical subs falling out of scope'; + +{ + BEGIN { lexical_import fribbler => sub { 3*shift } } + is fribbler(15), 45, 'lexical subs via pad_add_name'; + no warnings; + use feature 'lexical_subs'; + our sub fribbler; + is fribbler(15), 30, 'our sub overrides XS-registered lexical sub'; +} |