diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rwxr-xr-x | t/op/args.t | 64 | ||||
| -rwxr-xr-x | t/op/nothr5005.t | 35 |
3 files changed, 32 insertions, 68 deletions
@@ -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 90a7d25771..4ea224d885 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 411a0b470e..0000000000 --- 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"; - } |