ext/threads-shared/t/sv_simple.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     use Config;
   6     if (! $Config{'useithreads'}) {
   7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
   8         exit(0);
   9     }
  10 }
  11
  12 use ExtUtils::testlib;
  13
  14 sub ok {
  15     my ($id, $ok, $name) = @_;
  16
  17     # You have to do it this way or VMS will get confused.
  18     if ($ok) {
  19         print("ok $id - $name\n");
  20     } else {
  21         print("not ok $id - $name\n");
  22         printf("# Failed test at line %d\n", (caller)[2]);
  23     }
  24
  25     return ($ok);
  26 }
  27
  28 BEGIN {
  29     $| = 1;
  30     print("1..11\n");   ### Number of tests that will be run ###
  31 };
  32
  33 use threads;
  34 use threads::shared;
  35 ok(1, 1, 'Loaded');
  36
  37 ### Start of Testing ###
  38
  39 my $test = "bar";
  40 share($test);
  41 ok(2,$test eq "bar","Test magic share fetch");
  42 $test = "foo";
  43 ok(3,$test eq "foo","Test magic share assign");
  44 my $c = threads::shared::_refcnt($test);
  45 threads->create(
  46                 sub {
  47                     ok(4, $test eq "foo","Test magic share fetch after thread");
  48                     $test = "baz";
  49                     ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct");
  50                     })->join();
  51 ok(6,$test eq "baz","Test that value has changed in another thread");
  52 ok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly");
  53 $test = "barbar";
  54 ok(8, length($test) == 6, "Check length code");
  55 threads->create(sub { $test = "barbarbar" })->join;
  56 ok(9, length($test) == 9, "Check length code after different thread modified it");
  57 threads->create(sub { undef($test)})->join();
  58 ok(10, !defined($test), "Check undef value");
  59
  60 ok(11, is_shared($test), "Check for sharing");
  61
  62 exit(0);
  63
  64 # EOF