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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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<REFERENCE>
 
@@ -1956,7 +1961,10 @@ of C<my_cxt_t>.
 
 The MY_CXT_INIT macro initialises storage for the C<my_cxt_t> struct.
 
-It I<must> be called exactly once -- typically in a BOOT: section.
+It I<must> 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<MY_CXT_CLONE> below.)
 
 =item dMY_CXT
 
@@ -1977,6 +1985,34 @@ then use this to access the C<index> member
     dMY_CXT;
     MY_CXT.index = 2;
 
+=item aMY_CXT/pMY_CXT
+
+C<dMY_CXT> 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<aMY_CXT>/C<pMY_CXT> macros, eg
+
+    void sub1() {
+       dMY_CXT;
+       MY_CXT.index = 1;
+       sub2(aMY_CXT);
+    }
+
+    void sub2(pMY_CXT) {
+       MY_CXT.index = 2;
+    }
+
+Analogously to C<pTHX>, 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<aMY_CXT_>, C<_pMY_CXT> and C<pMY_CXT_>.
+
+=item MY_CXT_CLONE
+
+By default, when a new interpreter is created as a copy of an existing one
+(eg via C<<threads->new()>>), both interpreters share the same physical
+my_cxt_t structure. Calling C<MY_CXT_CLONE> (typically via the package's
+C<CLONE()> 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