Move threads from ext/ to dist/
[perl.git] / 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