From: Nick Ing-Simmons Date: Sat, 1 Nov 1997 00:02:49 +0000 (+0000) Subject: Test changes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf3d9ec563d250542a3477e399206648d90ace80;p=p5sagit%2Fp5-mst-13.2.git Test changes p4raw-id: //depot/ansiperl@197 --- diff --git a/MANIFEST b/MANIFEST index 363b264..171d751 100644 --- a/MANIFEST +++ b/MANIFEST @@ -211,7 +211,6 @@ ext/Socket/Socket.xs Socket extension external subroutines ext/Thread/Makefile.PL Thread extension makefile writer ext/Thread/Notes Thread notes ext/Thread/README Thread README -ext/Thread/Thread Directory for Thread:: submodules ext/Thread/Thread/Queue.pm Thread synchronised queue objects ext/Thread/Thread/Semaphore.pm Thread semaphore objects ext/Thread/Thread.pm Thread extension Perl module @@ -721,6 +720,7 @@ t/lib/symbol.t See if Symbol works t/lib/texttabs.t See if Text::Tabs works t/lib/textwrap.t See if Text::Wrap works t/lib/timelocal.t See if Time::Local works +t/lib/thread.t Basic test of threading (skipped if no threads) t/lib/trig.t See if Math::Trig works t/op/append.t See if . works t/op/arith.t See if arithmetic works @@ -755,6 +755,7 @@ t/op/method.t See if method calls work t/op/misc.t See if miscellaneous bugs have been fixed t/op/mkdir.t See if mkdir works t/op/my.t See if lexical scoping works +t/op/nothread.t local @_ test which does not work threaded t/op/oct.t See if oct and hex work t/op/ord.t See if ord works t/op/pack.t See if pack and unpack work @@ -800,6 +801,7 @@ t/pragma/warn-1global Tests of global warnings for warning.t t/pragma/warning.t See if warning controls work taint.c Tainting code thread.h Threading header +thread.sym Symbols for threads toke.c The tokener universal.c The default UNIVERSAL package methods unixish.h Defines that are assumed on Unix diff --git a/t/lib/thread.t b/t/lib/thread.t new file mode 100644 index 0000000..798adc1 --- /dev/null +++ b/t/lib/thread.t @@ -0,0 +1,54 @@ +#!perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'ccflags'} !~ /-DUSE_THREADS\b/) { + print "1..0\n"; + exit 0; + } +} +$| = 1; +print "1..9\n"; +use Thread; +print "ok 1\n"; + +sub content +{ + print shift; + return shift; +} + +# create a thread passing args and immedaietly wait for it. +my $t = new Thread \&content,("ok 2\n","ok 3\n"); +print $t->join; + +# check that lock works ... +{lock $foo; + $t = new Thread sub { lock $foo; print "ok 5\n" }; + print "ok 4\n"; +} +$t->join; + +sub islocked +{ + use attrs 'locked'; + my $val = shift; + my $ret; + if (@_) + { + $ret = new Thread \&islocked,shift; + sleep 2; + } + print $val; +} + +$t = islocked("ok 6\n","ok 7\n"); +join $t; + +# test that sleep lets other thread run +$t = new Thread \&islocked,"ok 8\n"; +sleep 2; +print "ok 9"; +join $t; diff --git a/t/op/nothread.t b/t/op/nothread.t new file mode 100644 index 0000000..acc2089 --- /dev/null +++ b/t/op/nothread.t @@ -0,0 +1,35 @@ +#!./perl + +# NOTE: Please don't add tests to this file unless they *need* to be run in +# separate executable and can't simply use eval. + +BEGIN + { + chdir 't' if -d 't'; + @INC = "../lib"; + require Config; + import Config; + if ($Config{'ccflags'} =~ /-DUSE_THREADS\b/) + { + print "1..0\n"; + exit 0; + } + } + + +$|=1; + +print "1..9\n"; +$t = 1; +sub foo { local(@_) = ('p', 'q', 'r'); } +sub bar { unshift @_, 'D'; @_ } +sub baz { push @_, 'E'; return @_ } +for (1..3) + { + print "not " unless join('',foo('a', 'b', 'c')) eq 'pqr'; + print "ok ",$t++,"\n"; + print "not" unless join('',bar('d')) eq 'Dd'; + print "ok ",$t++,"\n"; + print "not" unless join('',baz('e')) eq 'eE'; + print "ok ",$t++,"\n"; + } diff --git a/thread.sym b/thread.sym new file mode 100644 index 0000000..4e768b5 --- /dev/null +++ b/thread.sym @@ -0,0 +1 @@ +# \ No newline at end of file