ext/XS-APItest/t/my_cxt.t

   1 #!perl -w
   2
   3 # test per-interpeter static data API (MY_CXT)
   4 # DAPM Dec 2005
   5
   6 my $threads;
   7 BEGIN {
   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
  23 use warnings;
  24 use strict;
  25
  26 use Test::More tests => 16;
  27
  28 BEGIN {
  29     use_ok('XS::APItest');
  30 };
  31
  32 is(my_cxt_getint(), 99, "initial int value");
  33 is(my_cxt_getsv($_),  "initial", "initial SV value$_")
  34     foreach '', ' (context arg)';
  35
  36 my_cxt_setint(1234);
  37 is(my_cxt_getint(), 1234, "new int value");
  38
  39 my_cxt_setsv("abcd");
  40 is(my_cxt_getsv($_),  "abcd", "new SV value$_")
  41     foreach '', ' (context arg)';
  42
  43 sub 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
  55 SKIP: {
  56     skip "No threads", 6 unless $threads;
  57     threads->create(\&do_thread)->join;
  58 }
  59
  60 is(my_cxt_getint(), 1234,  "int value preserved after join");
  61 is(my_cxt_getsv($_),  "abcd", "SV value preserved after join$_")
  62         foreach '', ' (context arg)';