From cdbcf450a6724e04d0f4998b4e10f0f280d99586 Mon Sep 17 00:00:00 2001 From: "Jerry D. Hedden" Date: Thu, 26 Oct 2006 01:35:46 -0700 Subject: [PATCH] Integrate: [ 26522] add tests for MY_CXT API and improve its documentation [ 29124] Subject: [PATCH] Change MY_CXT ref in perl.h From: "Jerry D. Hedden" Message-ID: <20061026153546.71547.qmail@web30214.mail.mud.yahoo.com> p4raw-link: @29124 on //depot/perl: 7588b095b4fd2549b6878a1928233682c0412566 p4raw-link: @26522 on //depot/perl: 85ce96a160e902929b94338ada20cf46b265d595 p4raw-id: //depot/maint-5.8/perl@30262 p4raw-branched: from //depot/perl@30261 'branch in' ext/XS/APItest/t/my_cxt.t p4raw-integrated: from //depot/perl@29124 'merge in' perl.h (@29075..) p4raw-integrated: from //depot/perl@26522 'merge in' ext/XS/APItest/APItest.pm (@25261..) pod/perlxs.pod (@26073..) ext/XS/APItest/APItest.xs (@26171..) MANIFEST (@26498..) --- MANIFEST | 1 + ext/XS/APItest/APItest.pm | 3 +- ext/XS/APItest/APItest.xs | 76 +++++++++++++++++++++++++++++++++++++++++++++++ ext/XS/APItest/t/my_cxt.t | 57 +++++++++++++++++++++++++++++++++++ perl.h | 5 ++-- pod/perlxs.pod | 38 +++++++++++++++++++++++- 6 files changed, 176 insertions(+), 4 deletions(-) create mode 100644 ext/XS/APItest/t/my_cxt.t diff --git a/MANIFEST b/MANIFEST index 4eec0ab..6f75217 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1001,6 +1001,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 814683d..4988dc8 100644 --- a/ext/XS/APItest/APItest.pm +++ b/ext/XS/APItest/APItest.pm @@ -21,6 +21,7 @@ our @EXPORT = qw( print_double print_int print_long G_KEEPERR G_NODEBUG G_METHOD exception mycroak strtab + my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv ); # from cop.h @@ -34,7 +35,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 8d09a34..ceac805 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); @@ -212,6 +243,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 @@ -437,3 +481,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/perl.h b/perl.h index 98e93ac..ae2a0d7 100644 --- a/perl.h +++ b/perl.h @@ -5153,8 +5153,9 @@ typedef struct am_table_short AMTS; /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use - * this, if you want to make the extension thread-safe. See ext/re/re.xs - * for an example of the use of these macros, and perlxs.pod for more. + * this, if you want to make the extension thread-safe. See + * ext/XS/APItest/APItest.xs for an example of the use of these macros, + * and perlxs.pod for more. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. diff --git a/pod/perlxs.pod b/pod/perlxs.pod index 53ff964..a30dbcc 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 =head2 Thread-aware system interfaces -- 1.8.3.1