5 if ($ENV{'PERL_CORE'}){
7 unshift @INC, '../lib';
10 if (! $Config{'useithreads'}) {
11 print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
16 use ExtUtils::testlib;
19 my ($id, $ok, $name) = @_;
21 # You have to do it this way or VMS will get confused.
23 print("ok $id - $name\n");
25 print("not ok $id - $name\n");
26 printf("# Failed test at line %d\n", (caller)[2]);
34 print("1..21\n"); ### Number of tests that will be run ###
41 ### Start of Testing ###
46 eval { $foo = \$bar; };
47 ok(2,my $temp1 = $@ =~/^Invalid\b.*shared scalar/, "Wrong error message");
51 ok(3, $temp1 = $foo =~/SCALAR/, "Check that is a ref");
52 ok(4, $$foo eq "foo", "Check that it points to the correct value");
54 ok(5, $$foo eq "yeah", "Check that assignment works");
56 ok(6, $$foo eq "yeah2", "Check that deref assignment works");
57 threads->create(sub {$bar = "yeah3"})->join();
58 ok(7, $$foo eq "yeah3", "Check that other thread assignemtn works");
59 threads->create(sub {$foo = "artur"})->join();
60 ok(8, $foo eq "artur", "Check that uncopupling the ref works");
66 ok(9,$$$foo eq 'original', "Check reference chain");
72 threads->create(sub { $t1 = "bar" })->join();
73 ok(10,$t1 eq 'bar',"Check that assign to a ROK works");
75 ok(11, is_shared($foo), "Check for sharing");
78 # Circular references with 3 shared scalars
86 ok(12, ref($x) eq 'REF', '$x ref type');
87 ok(13, ref($y) eq 'REF', '$y ref type');
88 ok(14, ref($z) eq 'REF', '$z ref type');
91 ok(15, ref($q[0]) eq 'REF', '$q[0] ref type');
94 ok(16, ref($w) eq 'REF', '$w ref type');
95 ok(17, ref($$w) eq 'REF', '$$w ref type');
96 ok(18, ref($$$w) eq 'REF', '$$$w ref type');
97 ok(19, ref($$$$w) eq 'REF', '$$$$w ref type');
99 ok(20, is_shared($x) == is_shared($w), '_id($x) == _id($w)');
100 ok(21, is_shared($w) == is_shared($$$$w), '_id($w) == _id($$$$w)');