1#!perl -w 2 3# test per-interpeter static data API (MY_CXT) 4# DAPM Dec 2005 5 6my $threads; 7BEGIN { 8 chdir 't' if -d 't'; 9 @INC = '../lib'; 10 push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; 11 require Config; import Config; 12 if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { 13 # Look, I'm using this fully-qualified variable more than once! 14 my $arch = $MacPerl::Architecture; 15 print "1..0 # Skip: XS::APItest was not built\n"; 16 exit 0; 17 } 18 $threads = $Config{'useithreads'}; 19 # must 'use threads' before 'use Test::More' 20 eval 'use threads' if $threads; 21} 22 23use warnings; 24use strict; 25 26use Test::More tests => 16; 27 28BEGIN { 29 use_ok('XS::APItest'); 30}; 31 32is(my_cxt_getint(), 99, "initial int value"); 33is(my_cxt_getsv($_), "initial", "initial SV value$_") 34 foreach '', ' (context arg)'; 35 36my_cxt_setint(1234); 37is(my_cxt_getint(), 1234, "new int value"); 38 39my_cxt_setsv("abcd"); 40is(my_cxt_getsv($_), "abcd", "new SV value$_") 41 foreach '', ' (context arg)'; 42 43sub do_thread { 44 is(my_cxt_getint(), 1234, "initial int value (child)"); 45 my_cxt_setint(4321); 46 is(my_cxt_getint(), 4321, "new int value (child)"); 47 48 is(my_cxt_getsv($_), "initial_clone", "initial sv value (child)$_") 49 foreach '', ' (context arg)'; 50 my_cxt_setsv("dcba"); 51 is(my_cxt_getsv($_), "dcba", "new SV value (child)$_") 52 foreach '', ' (context arg)'; 53} 54 55SKIP: { 56 skip "No threads", 6 unless $threads; 57 threads->create(\&do_thread)->join; 58} 59 60is(my_cxt_getint(), 1234, "int value preserved after join"); 61is(my_cxt_getsv($_), "abcd", "SV value preserved after join$_") 62 foreach '', ' (context arg)'; 63