ext/threads/shared/t/sv_simple.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..11\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 $test = "bar";
  44 share($test);
  45 ok(2,$test eq "bar","Test magic share fetch");
  46 $test = "foo";
  47 ok(3,$test eq "foo","Test magic share assign");
  48 my $c = threads::shared::_refcnt($test);
  49 threads->create(
  50                 sub {
  51                     ok(4, $test eq "foo","Test magic share fetch after thread");
  52                     $test = "baz";
  53                     ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct");
  54                     })->join();
  55 ok(6,$test eq "baz","Test that value has changed in another thread");
  56 ok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly");
  57 $test = "barbar";
  58 ok(8, length($test) == 6, "Check length code");
  59 threads->create(sub { $test = "barbarbar" })->join;
  60 ok(9, length($test) == 9, "Check length code after different thread modified it");
  61 threads->create(sub { undef($test)})->join();
  62 ok(10, !defined($test), "Check undef value");
  63
  64 ok(11, is_shared($test), "Check for sharing");
  65
  66 # EOF