ext/threads/shared/t/sv_simple.t

   1
   2
   3
   4
   5 BEGIN {
   6 #    chdir 't' if -d 't';
   7 #    push @INC ,'../lib';
   8     require Config; import Config;
   9     unless ($Config{'useithreads'}) {
  10         print "1..0 # Skip: no useithreads\n";
  11         exit 0;
  12     }
  13 }
  14
  15
  16 sub ok {
  17     my ($id, $ok, $name) = @_;
  18
  19     # You have to do it this way or VMS will get confused.
  20     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
  21
  22     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
  23
  24     return $ok;
  25 }
  26
  27
  28 use ExtUtils::testlib;
  29 use strict;
  30 BEGIN { print "1..10\n" };
  31 use threads;
  32 use threads::shared;
  33 ok(1,1,"loaded");
  34 my $test = "bar";
  35 share($test);
  36 ok(2,$test eq "bar","Test magic share fetch");
  37 $test = "foo";
  38 ok(3,$test eq "foo","Test magic share assign");
  39 threads->create(
  40                 sub {
  41                     ok(4, $test eq "foo","Test mage share fetch after thread");
  42                     $test = "baz";
  43                     ok(5,threads::shared::_thrcnt($test) == 2, "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::_thrcnt($test) == 1,"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