ext/threads/shared/t/sv_simple.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
  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 my $test = "bar";
  34 share($test);
  35 ok(2,$test eq "bar","Test magic share fetch");
  36 $test = "foo";
  37 ok(3,$test eq "foo","Test magic share assign");
  38 my $c = threads::shared::_refcnt($test);
  39 threads->create(
  40                 sub {
  41                     ok(4, $test eq "foo","Test magic share fetch after thread");
  42                     $test = "baz";
  43                     ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct");
  44                     })->join();
  45 ok(6,$test eq "baz","Test that value has changed in another thread");
  46 ok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly");
  47 $test = "barbar";
  48 ok(8, length($test) == 6, "Check length code");
  49 threads->create(sub { $test = "barbarbar" })->join;
  50 ok(9, length($test) == 9, "Check length code after different thread modified it");
  51 threads->create(sub { undef($test)})->join();
  52 ok(10, !defined($test), "Check undef value");
  53
  54
  55
  56
  57
  58
  59