From: Dave Mitchell Date: Thu, 29 Dec 2005 11:35:04 +0000 (+0000) Subject: add tests for MY_CXT API and improve its documentation X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=85ce96a160e902929b94338ada20cf46b265d595;p=p5sagit%2Fp5-mst-13.2.git add tests for MY_CXT API and improve its documentation p4raw-id: //depot/perl@26522 --- diff --git a/MANIFEST b/MANIFEST index f2ab295..6018a97 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1050,6 +1050,7 @@ ext/XS/APItest/Makefile.PL XS::APItest extension ext/XS/APItest/MANIFEST XS::APItest extension ext/XS/APItest/README XS::APItest extension ext/XS/APItest/t/call.t XS::APItest extension +ext/XS/APItest/t/my_cxt.t XS::APItest: test MY_CXT interface ext/XS/APItest/t/exception.t XS::APItest extension ext/XS/APItest/t/hash.t XS::APItest extension ext/XS/APItest/t/printf.t XS::APItest extension diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm index 73cba40..b9988c1 100644 --- a/ext/XS/APItest/APItest.pm +++ b/ext/XS/APItest/APItest.pm @@ -20,6 +20,7 @@ our @EXPORT = qw( print_double print_int print_long G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS G_KEEPERR G_NODEBUG G_METHOD exception mycroak strtab + my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv ); # from cop.h @@ -33,7 +34,7 @@ sub G_KEEPERR() { 16 } sub G_NODEBUG() { 32 } sub G_METHOD() { 64 } -our $VERSION = '0.08'; +our $VERSION = '0.09'; bootstrap XS::APItest $VERSION; diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs index 873db7e..22279bc 100644 --- a/ext/XS/APItest/APItest.xs +++ b/ext/XS/APItest/APItest.xs @@ -3,6 +3,37 @@ #include "perl.h" #include "XSUB.h" + +/* for my_cxt tests */ + +#define MY_CXT_KEY "XS::APItest::_guts" XS_VERSION + +typedef struct { + int i; + SV *sv; +} my_cxt_t; + +START_MY_CXT + +/* indirect functions to test the [pa]MY_CXT macros */ +int +my_cxt_getint_p(pMY_CXT) +{ + return MY_CXT.i; +} +void +my_cxt_setint_p(pMY_CXT_ int i) +{ + MY_CXT.i = i; +} +void +my_cxt_setsv_p(SV* sv _pMY_CXT) +{ + MY_CXT.sv = sv; +} + + + /* from exception.c */ int exception(int); @@ -194,6 +225,19 @@ MODULE = XS::APItest PACKAGE = XS::APItest PROTOTYPES: DISABLE +BOOT: +{ + MY_CXT_INIT; + MY_CXT.i = 99; + MY_CXT.sv = newSVpv("initial",0); +} + +void +CLONE(...) + CODE: + MY_CXT_CLONE; + MY_CXT.sv = newSVpv("initial_clone",0); + void print_double(val) double val @@ -414,3 +458,35 @@ strtab() RETVAL = newRV_inc((SV*)PL_strtab); OUTPUT: RETVAL + +int +my_cxt_getint() + CODE: + dMY_CXT; + RETVAL = my_cxt_getint_p(aMY_CXT); + OUTPUT: + RETVAL + +void +my_cxt_setint(i) + int i; + CODE: + dMY_CXT; + my_cxt_setint_p(aMY_CXT_ i); + +void +my_cxt_getsv() + PPCODE: + dMY_CXT; + EXTEND(SP, 1); + ST(0) = MY_CXT.sv; + XSRETURN(1); + +void +my_cxt_setsv(sv) + SV *sv; + CODE: + dMY_CXT; + SvREFCNT_dec(MY_CXT.sv); + my_cxt_setsv_p(sv _aMY_CXT); + SvREFCNT_inc(sv); diff --git a/ext/XS/APItest/t/my_cxt.t b/ext/XS/APItest/t/my_cxt.t new file mode 100644 index 0000000..0b1c371 --- /dev/null +++ b/ext/XS/APItest/t/my_cxt.t @@ -0,0 +1,57 @@ +#!perl -w + +# test per-interpeter static data API (MY_CXT) +# DAPM Dec 2005 + +my $threads; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { + # Look, I'm using this fully-qualified variable more than once! + my $arch = $MacPerl::Architecture; + print "1..0 # Skip: XS::APItest was not built\n"; + exit 0; + } + $threads = $Config{'useithreads'}; + # must 'use threads' before 'use Test::More' + eval 'use threads' if $threads; +} + +use warnings; +use strict; + +use Test::More tests => 11; + +BEGIN { + use_ok('XS::APItest'); +}; + +is(my_cxt_getint(), 99, "initial int value"); +is(my_cxt_getsv(), "initial", "initial SV value"); + +my_cxt_setint(1234); +is(my_cxt_getint(), 1234, "new int value"); + +my_cxt_setsv("abcd"); +is(my_cxt_getsv(), "abcd", "new SV value"); + +sub do_thread { + is(my_cxt_getint(), 1234, "initial int value (child)"); + my_cxt_setint(4321); + is(my_cxt_getint(), 4321, "new int value (child)"); + + is(my_cxt_getsv(), "initial_clone", "initial sv value (child)"); + my_cxt_setsv("dcba"); + is(my_cxt_getsv(), "dcba", "new SV value (child)"); +} + +SKIP: { + skip "No threads", 4 unless $threads; + threads->new(\&do_thread)->join; +} + +is(my_cxt_getint(), 1234, "int value preserved after join"); +is(my_cxt_getsv(), "abcd", "SV value preserved after join"); diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 462f84c..b3ba08f 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -1921,6 +1921,11 @@ Below is an example module that makes use of the macros. else RETVAL = newSVpv(MY_CXT.name[index - 1]); + void + CLONE(...) + CODE: + MY_CXT_CLONE; + B @@ -1956,7 +1961,10 @@ of C. The MY_CXT_INIT macro initialises storage for the C struct. -It I be called exactly once -- typically in a BOOT: section. +It I be called exactly once -- typically in a BOOT: section. If you +are maintaining multiple interpreters, it should be called once in each +interpreter instance, except for interpreters cloned from existing ones. +(But see C below.) =item dMY_CXT @@ -1977,6 +1985,34 @@ then use this to access the C member dMY_CXT; MY_CXT.index = 2; +=item aMY_CXT/pMY_CXT + +C may be quite expensive to calculate, and to avoid the overhead +of invoking it in each function it is possible to pass the declaration +onto other functions using the C/C macros, eg + + void sub1() { + dMY_CXT; + MY_CXT.index = 1; + sub2(aMY_CXT); + } + + void sub2(pMY_CXT) { + MY_CXT.index = 2; + } + +Analogously to C, there are equivalent forms for when the macro is the +first or last in multiple arguments, where an underscore represents a +comma, i.e. C<_aMY_CXT>, C, C<_pMY_CXT> and C. + +=item MY_CXT_CLONE + +By default, when a new interpreter is created as a copy of an existing one +(eg via C<new()>>), both interpreters share the same physical +my_cxt_t structure. Calling C (typically via the package's +C function), causes a byte-for-byte copy of the structure to be +taken, and any future dMY_CXT will cause the copy to be accessed instead. + =back =head1 EXAMPLES