ext/threads/shared/t/sv_refs.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 use Devel::Peek;
  27 use ExtUtils::testlib;
  28 use strict;
  29 BEGIN { print "1..10\n" };
  30 use threads;
  31 use threads::shared;
  32 ok(1,1,"loaded");
  33
  34 my $foo;
  35 my $bar = "foo";
  36 share($foo);
  37 eval {
  38 $foo = \$bar;
  39 };
  40
  41 ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message");
  42 share($bar);
  43 $foo = \$bar;
  44 ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref");
  45 ok(4, $$foo eq "foo", "Check that it points to the correct value");
  46 $bar = "yeah";
  47 ok(5, $$foo eq "yeah", "Check that assignment works");
  48 $$foo = "yeah2";
  49 ok(6, $$foo eq "yeah2", "Check that deref assignment works");
  50 threads->create(sub {$bar = "yeah3"})->join();
  51 ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works");
  52 threads->create(sub {$foo = "artur"})->join();
  53 ok(8, $foo eq "artur", "Check that uncopupling the ref works");
  54 my $baz;
  55 share($baz);
  56 $baz = "original";
  57 $bar = \$baz;
  58 $foo = \$bar;
  59 ok(9,$$$foo eq 'original', "Check reference chain");
  60 my($t1,$t2);
  61 share($t1);
  62 share($t2);
  63 $t2 = "text";
  64 $t1 = \$t2;
  65 threads->create(sub { $t1 = "bar" })->join();
  66 ok(10,$t1 eq 'bar',"Check that assign to a ROK works");