Move threads from ext/ to dist/
[perl.git] / ext / threads-shared / t / sv_refs.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..21\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 $foo;
40 my $bar = "foo";
41 share($foo);
42 eval { $foo = \$bar; };
43 ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message");
44
45 share($bar);
46 $foo = \$bar;
47 ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref");
48 ok(4, $$foo eq "foo", "Check that it points to the correct value");
49 $bar = "yeah";
50 ok(5, $$foo eq "yeah", "Check that assignment works");
51 $$foo = "yeah2";
52 ok(6, $$foo eq "yeah2", "Check that deref assignment works");
53 threads->create(sub {$bar = "yeah3"})->join();
54 ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works");
55 threads->create(sub {$foo = "artur"})->join();
56 ok(8, $foo eq "artur", "Check that uncopupling the ref works");
57 my $baz;
58 share($baz);
59 $baz = "original";
60 $bar = \$baz;
61 $foo = \$bar;
62 ok(9,$$$foo eq 'original', "Check reference chain");
63 my($t1,$t2);
64 share($t1);
65 share($t2);
66 $t2 = "text";
67 $t1 = \$t2;
68 threads->create(sub { $t1 = "bar" })->join();
69 ok(10,$t1 eq 'bar',"Check that assign to a ROK works");
70
71 ok(11, is_shared($foo), "Check for sharing");
72
73 {
74     # Circular references with 3 shared scalars
75     my $x : shared;
76     my $y : shared;
77     my $z : shared;
78
79     $x = \$y;
80     $y = \$z;
81     $z = \$x;
82     ok(12, ref($x) eq 'REF', '$x ref type');
83     ok(13, ref($y) eq 'REF', '$y ref type');
84     ok(14, ref($z) eq 'REF', '$z ref type');
85
86     my @q :shared = ($x);
87     ok(15, ref($q[0]) eq 'REF', '$q[0] ref type');
88
89     my $w = $q[0];
90     ok(16, ref($w) eq 'REF', '$w ref type');
91     ok(17, ref($$w) eq 'REF', '$$w ref type');
92     ok(18, ref($$$w) eq 'REF', '$$$w ref type');
93     ok(19, ref($$$$w) eq 'REF', '$$$$w ref type');
94
95     ok(20, is_shared($x) == is_shared($w), '_id($x) == _id($w)');
96     ok(21, is_shared($w) == is_shared($$$$w), '_id($w) == _id($$$$w)');
97 }
98
99 exit(0);
100
101 # EOF