This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[ANNOUNCE] Math::BigInt v1.69
[perl5.git] / ext / threads / shared / t / sv_simple.t
CommitLineData
13c1b207 1use warnings;
b050c948
AB
2
3BEGIN {
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
14sub ok {
15 my ($id, $ok, $name) = @_;
16
13c1b207 17 $name = '' unless defined $name;
b050c948
AB
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
27use ExtUtils::testlib;
28use strict;
29BEGIN { print "1..10\n" };
30use threads;
31use threads::shared;
32ok(1,1,"loaded");
33my $test = "bar";
34share($test);
35ok(2,$test eq "bar","Test magic share fetch");
36$test = "foo";
37ok(3,$test eq "foo","Test magic share assign");
6b85e4fe 38my $c = threads::shared::_refcnt($test);
b050c948
AB
39threads->create(
40 sub {
a446a88f 41 ok(4, $test eq "foo","Test magic share fetch after thread");
b050c948 42 $test = "baz";
6b85e4fe 43 ok(5,threads::shared::_refcnt($test) > $c, "Check that threadcount is correct");
b050c948
AB
44 })->join();
45ok(6,$test eq "baz","Test that value has changed in another thread");
6b85e4fe 46ok(7,threads::shared::_refcnt($test) == $c,"Check thrcnt is down properly");
b050c948
AB
47$test = "barbar";
48ok(8, length($test) == 6, "Check length code");
49threads->create(sub { $test = "barbarbar" })->join;
50ok(9, length($test) == 9, "Check length code after different thread modified it");
51threads->create(sub { undef($test)})->join();
52ok(10, !defined($test), "Check undef value");
53
54
55
56
57
58
59