From: Rafael Garcia-Suarez Date: Thu, 9 Oct 2003 11:09:24 +0000 (+0000) Subject: Suppress the test file t/op/nothr5005.t and integrate its tests into X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1c2b4d67977aeb5bb1057ed40fce97cdd133e14a;p=p5sagit%2Fp5-mst-13.2.git Suppress the test file t/op/nothr5005.t and integrate its tests into t/op/args.t, now that 5005threads have been removed. Port t/op/args.t to t/test.pl. p4raw-id: //depot/perl@21432 --- diff --git a/MANIFEST b/MANIFEST index 0e69ff6..6d27169 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2750,7 +2750,6 @@ t/op/method.t See if method calls work t/op/mkdir.t See if mkdir works t/op/my_stash.t See if my Package works t/op/my.t See if lexical scoping works -t/op/nothr5005.t local @_ test which does not work under use5005threads t/op/numconvert.t See if accessing fields does not change numeric values t/op/oct.t See if oct and hex work t/op/ord.t See if ord works diff --git a/t/op/args.t b/t/op/args.t index 90a7d25..4ea224d 100755 --- a/t/op/args.t +++ b/t/op/args.t @@ -1,56 +1,45 @@ #!./perl -print "1..11\n"; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +require './test.pl'; +plan( tests => 20 ); # test various operations on @_ -my $ord = 0; sub new1 { bless \@_ } { my $x = new1("x"); my $y = new1("y"); - ++$ord; - print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y"; - print "ok $ord\n"; - ++$ord; - print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x"; - print "ok $ord\n"; + is("@$y","y"); + is("@$x","x"); } sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ } { my $x = new2("x"); my $y = new2("y"); - ++$ord; - print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x"; - print "ok $ord\n"; - ++$ord; - print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; - print "ok $ord\n"; + is("@$x","a b c x"); + is("@$y","a b c y"); } sub new3 { goto &new1 } { my $x = new3("x"); my $y = new3("y"); - ++$ord; - print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y"; - print "ok $ord\n"; - ++$ord; - print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x"; - print "ok $ord\n"; + is("@$y","y"); + is("@$x","x"); } sub new4 { goto &new2 } { my $x = new4("x"); my $y = new4("y"); - ++$ord; - print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x"; - print "ok $ord\n"; - ++$ord; - print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y"; - print "ok $ord\n"; + is("@$x","a b c x"); + is("@$y","a b c y"); } # see if POPSUB gets to see the right pad across a dounwind() with @@ -71,18 +60,29 @@ sub try { } for (1..5) { try() } -++$ord; -print "ok $ord\n"; +pass(); # bug #21542 local $_[0] causes reify problems and coredumps sub local1 { local $_[0] } my $foo = 'foo'; local1($foo); local1($foo); print "got [$foo], expected [foo]\nnot " if $foo ne 'foo'; -$ord++; -print "ok $ord\n"; +pass(); sub local2 { local $_[0]; last L } L: { local2 } -$ord++; -print "ok $ord\n"; +pass(); + +# the following test for local(@_) used to be in t/op/nothr5005.t (because it +# failed with 5005threads) + +$|=1; + +sub foo { local(@_) = ('p', 'q', 'r'); } +sub bar { unshift @_, 'D'; @_ } +sub baz { push @_, 'E'; return @_ } +for (1..3) { + is(join('',foo('a', 'b', 'c')),'pqr'); + is(join('',bar('d')),'Dd'); + is(join('',baz('e')),'eE'); +} diff --git a/t/op/nothr5005.t b/t/op/nothr5005.t deleted file mode 100755 index 411a0b4..0000000 --- a/t/op/nothr5005.t +++ /dev/null @@ -1,35 +0,0 @@ -#!./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{'use5005threads'}) - { - print "1..0 # Skip: this perl is threaded\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"; - }