5 require Config; import Config;
6 unless ($Config{'useithreads'}) {
7 print "1..0 # Skip: no useithreads\n";
17 # Note that we can't use Test::More here, as we would need to
18 # call is() from within the DESTROY() function at global destruction time,
19 # and parts of Test::* may have already been freed by then
23 my $test : shared = 1;
26 my ($got, $want, $desc) = @_;
27 unless ($got eq $want) {
28 print "# EXPECTED: $want\n";
32 print "ok $test - $desc\n";
38 # This tests for too much destruction
39 # which was caused by cloning stashes
40 # on join which led to double the dataspace
42 #########################
49 my ($package, $file, $line) = caller;
50 is(threads->tid(),$self->{tid},
51 "In destroy[$self->{tid}] it should be correct too" )
54 $foo = bless {tid => 0}, 'Foo';
55 my $bar = threads->create(sub {
56 is(threads->tid(),1, "And tid be 1 here");
64 # This tests whether we can call Config::myconfig after threads have been
65 # started (interpreter cloned). 5.8.1 and 5.8.2 contained a bug that would
66 # disallow that too be done, because an attempt was made to change a variable
67 # with the : unique attribute.
69 #########################
71 threads->new( sub {1} )->join;
72 my $not = eval { Config::myconfig() } ? '' : 'not ';
73 print "${not}ok $test - Are we able to call Config::myconfig after clone\n";
76 # bugid 24383 - :unique hashes weren't being made readonly on interpreter
77 # clone; check that they are.
79 our $unique_scalar : unique;
80 our @unique_array : unique;
81 our %unique_hash : unique;
84 eval { $unique_scalar = 1 };
85 print $@ =~ /read-only/ ? '' : 'not ', "ok $test - unique_scalar\n";
87 eval { $unique_array[0] = 1 };
88 print $@ =~ /read-only/ ? '' : 'not ', "ok $test - unique_array\n";
90 eval { $unique_hash{abc} = 1 };
91 print $@ =~ /disallowed/ ? '' : 'not ', "ok $test - unique_hash\n";
96 # Returing a closure from a thread caused problems. If the last index in
97 # the anon sub's pad wasn't for a lexical, then a core dump could occur.
98 # Otherwise, there might be leaked scalars.
100 # XXX DAPM 9-Jan-04 - backed this out for now - returning a closure from a
101 # thread seems to crash win32
108 # my $string = threads->new(\&f)->join->();
109 # print $string eq 'foobar' ? '' : 'not ', "ok $test - returning closure\n";