ext/threads/shared/t/blessed.t

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