From: Jerry D. Hedden Date: Wed, 27 Jun 2007 14:15:16 +0000 (-0400) Subject: Move tests under 'threads' module X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=09576c7db8c59458f52d7746e7f4062d64ff34e7;p=p5sagit%2Fp5-mst-13.2.git Move tests under 'threads' module From: "Jerry D. Hedden" Message-ID: <1ff86f510706271115n6c816334nbde6774792743a54@mail.gmail.com> p4raw-id: //depot/perl@31488 --- diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index cdeccd4..3e337a4 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -30,7 +30,7 @@ BEGIN { } $| = 1; - print("1..31\n"); ### Number of tests that will be run ### + print("1..33\n"); ### Number of tests that will be run ### }; print("ok 1 - Loaded\n"); @@ -178,6 +178,22 @@ run_perl(prog => 'use threads 1.63;' . switches => ($ENV{PERL_CORE}) ? [] : [ '-Mblib' ]); is($?, 0, 'coredump in global destruction'); +# Attempt to free unreferenced scalar... +fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via scalar'); + use threads; + my $test = sub {}; + threads->create($test)->join(); + print 'ok'; +EOI + +# Attempt to free unreferenced scalar... +fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via $_[0]'); + use threads; + sub thr { threads->new($_[0]); } + thr(sub { })->join; + print 'ok'; +EOI + # test CLONE_SKIP() functionality if ($] >= 5.008007) { my %c : shared; @@ -288,11 +304,11 @@ if ($] >= 5.008007) { "counts of calls to DESTROY"); } else { - print("ok 27 # Skip objs clone skip at depth 0\n"); - print("ok 28 # Skip objs clone skip at depth 1\n"); - print("ok 29 # Skip objs clone skip at depth 2\n"); - print("ok 30 # Skip counts of calls to CLONE_SKIP\n"); - print("ok 31 # Skip counts of calls to DESTROY\n"); + print("ok 29 # Skip objs clone skip at depth 0\n"); + print("ok 30 # Skip objs clone skip at depth 1\n"); + print("ok 31 # Skip objs clone skip at depth 2\n"); + print("ok 32 # Skip counts of calls to CLONE_SKIP\n"); + print("ok 33 # Skip counts of calls to DESTROY\n"); } # EOF diff --git a/t/op/threads.t b/t/op/threads.t index bd4009c..e52a115 100644 --- a/t/op/threads.t +++ b/t/op/threads.t @@ -1,25 +1,26 @@ -#!./perl +#!perl + BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; $| = 1; -} -use strict; -use Config; - -BEGIN { - if (!$Config{useithreads}) { - print "1..0 # Skip: no ithreads\n"; - exit 0; + require Config; + if (!$Config::Config{useithreads}) { + print "1..0 # Skip: no ithreads\n"; + exit 0; } if ($ENV{PERL_CORE_MINITEST}) { print "1..0 # Skip: no dynamic loading on miniperl, no threads\n"; exit 0; } - plan(11); + + plan(9); } + +use strict; +use warnings; use threads; # test that we don't get: @@ -114,28 +115,11 @@ use threads; print do 'op/threads_create.pl' || die $@; EOI -# Attempt to free unreferenced scalar... -fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via scalar'); - use threads; - my $test = sub {}; - threads->create($test)->join(); - print 'ok'; -EOI - -# Attempt to free unreferenced scalar... -fresh_perl_is(<<'EOI', 'ok', { }, 'thread sub via $_[0]'); - use threads; - sub thr { threads->new($_[0]); } - thr(sub { })->join; - print 'ok'; -EOI TODO: { no strict 'vars'; # Accessing $TODO from test.pl local $TODO = 'refcount issues with threads'; - - # Scalars leaked: 1 foreach my $BLOCK (qw(CHECK INIT)) { fresh_perl_is(<