ext/threads/shared/t/blessed.t

   1 use warnings;
   2
   3 BEGIN {
   4 #    chdir 't' if -d 't';
   5 #    push @INC ,'../lib';
   6     require Config; import Config;
   7     unless ($Config{'useithreads'}) {
   8         print "1..0 # Skip: no useithreads\n";
   9         exit 0;
  10     }
  11 }
  12
  13
  14 sub ok {
  15     my ($id, $ok, $name) = @_;
  16
  17     $name = '' unless defined $name;
  18     # You have to do it this way or VMS will get confused.
  19     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
  20
  21     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  22
  23     return $ok;
  24 }
  25
  26 sub skip {
  27     my ($id, $ok, $name) = @_;
  28     print "ok $id # skip _thrcnt - $name \n";
  29 }
  30
  31 use ExtUtils::testlib;
  32 use strict;
  33 BEGIN { print "1..36\n" };
  34 use threads;
  35 use threads::shared;
  36
  37 my ($hobj, $aobj, $sobj) : shared;
  38
  39 $hobj = &share({});
  40 $aobj = &share([]);
  41 my $sref = \do{ my $x };
  42 share($sref);
  43 $sobj = $sref;
  44
  45 threads->new(sub {
  46                 # Bless objects
  47                 bless $hobj, 'foo';
  48                 bless $aobj, 'bar';
  49                 bless $sobj, 'baz';
  50
  51                 # Add data to objects
  52                 $$aobj[0] = bless(&share({}), 'yin');
  53                 $$aobj[1] = bless(&share([]), 'yang');
  54                 $$aobj[2] = $sobj;
  55
  56                 $$hobj{'hash'}   = bless(&share({}), 'yin');
  57                 $$hobj{'array'}  = bless(&share([]), 'yang');
  58                 $$hobj{'scalar'} = $sobj;
  59
  60                 $$sobj = 3;
  61
  62                 # Test objects in child thread
  63                 ok(1, ref($hobj) eq 'foo', "hash blessing does work");
  64                 ok(2, ref($aobj) eq 'bar', "array blessing does work");
  65                 ok(3, ref($sobj) eq 'baz', "scalar blessing does work");
  66                 ok(4, $$sobj eq '3', "scalar contents okay");
  67
  68                 ok(5, ref($$aobj[0]) eq 'yin', "blessed hash in array");
  69                 ok(6, ref($$aobj[1]) eq 'yang', "blessed array in array");
  70                 ok(7, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
  71                 ok(8, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
  72
  73                 ok(9, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
  74                 ok(10, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
  75                 ok(11, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
  76                 ok(12, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
  77
  78              })->join;
  79
  80 # Test objects in parent thread
  81 ok(13, ref($hobj) eq 'foo', "hash blessing does work");
  82 ok(14, ref($aobj) eq 'bar', "array blessing does work");
  83 ok(15, ref($sobj) eq 'baz', "scalar blessing does work");
  84 ok(16, $$sobj eq '3', "scalar contents okay");
  85
  86 ok(17, ref($$aobj[0]) eq 'yin', "blessed hash in array");
  87 ok(18, ref($$aobj[1]) eq 'yang', "blessed array in array");
  88 ok(19, ref($$aobj[2]) eq 'baz', "blessed scalar in array");
  89 ok(20, ${$$aobj[2]} eq '3', "blessed scalar in array contents");
  90
  91 ok(21, ref($$hobj{'hash'}) eq 'yin', "blessed hash in hash");
  92 ok(22, ref($$hobj{'array'}) eq 'yang', "blessed array in hash");
  93 ok(23, ref($$hobj{'scalar'}) eq 'baz', "blessed scalar in hash");
  94 ok(24, ${$$hobj{'scalar'}} eq '3', "blessed scalar in hash contents");
  95
  96 threads->new(sub {
  97                 # Rebless objects
  98                 bless $hobj, 'oof';
  99                 bless $aobj, 'rab';
 100                 bless $sobj, 'zab';
 101
 102                 my $data = $$aobj[0];
 103                 bless $data, 'niy';
 104                 $$aobj[0] = $data;
 105                 $data = $$aobj[1];
 106                 bless $data, 'gnay';
 107                 $$aobj[1] = $data;
 108
 109                 $data = $$hobj{'hash'};
 110                 bless $data, 'niy';
 111                 $$hobj{'hash'} = $data;
 112                 $data = $$hobj{'array'};
 113                 bless $data, 'gnay';
 114                 $$hobj{'array'} = $data;
 115
 116                 $$sobj = 'test';
 117              })->join;
 118
 119 # Test reblessing
 120 ok(25, ref($hobj) eq 'oof', "hash reblessing does work");
 121 ok(26, ref($aobj) eq 'rab', "array reblessing does work");
 122 ok(27, ref($sobj) eq 'zab', "scalar reblessing does work");
 123 ok(28, $$sobj eq 'test', "scalar contents okay");
 124
 125 ok(29, ref($$aobj[0]) eq 'niy', "reblessed hash in array");
 126 ok(30, ref($$aobj[1]) eq 'gnay', "reblessed array in array");
 127 ok(31, ref($$aobj[2]) eq 'zab', "reblessed scalar in array");
 128 ok(32, ${$$aobj[2]} eq 'test', "reblessed scalar in array contents");
 129
 130 ok(33, ref($$hobj{'hash'}) eq 'niy', "reblessed hash in hash");
 131 ok(34, ref($$hobj{'array'}) eq 'gnay', "reblessed array in hash");
 132 ok(35, ref($$hobj{'scalar'}) eq 'zab', "reblessed scalar in hash");
 133 ok(36, ${$$hobj{'scalar'}} eq 'test', "reblessed scalar in hash contents");
 134