ext/XS-APItest/t/labelconst.aux auxiliary file for label test
ext/XS-APItest/t/labelconst.t test recursive descent label parsing
ext/XS-APItest/t/labelconst_utf8.aux auxiliary file for label test in UTF-8
+ext/XS-APItest/t/lexsub.t Test XS registration of lexical subs
ext/XS-APItest/t/loopblock.t test recursive descent block parsing
ext/XS-APItest/t/looprest.t test recursive descent statement-sequence parsing
ext/XS-APItest/t/lvalue.t Test XS lvalue functions
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
--- /dev/null
+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';
+}