diff options
Diffstat (limited to 't/op/caller.t')
-rw-r--r-- | t/op/caller.t | 37 |
1 files changed, 28 insertions, 9 deletions
diff --git a/t/op/caller.t b/t/op/caller.t index 1b08d93002..751a161de2 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -7,40 +7,59 @@ BEGIN { require './test.pl'; } -plan( tests => 9 ); +plan( tests => 20 ); my @c; +print "# Tests with caller(0)\n"; + @c = caller(0); ok( (!@c), "caller(0) in main program" ); eval { @c = caller(0) }; -is( $c[3], "(eval)", "caller(0) - subroutine name in an eval {}" ); +is( $c[3], "(eval)", "subroutine name in an eval {}" ); +ok( !$c[4], "hasargs false in an eval {}" ); eval q{ @c = (Caller(0))[3] }; -is( $c[3], "(eval)", "caller(0) - subroutine name in an eval ''" ); +is( $c[3], "(eval)", "subroutine name in an eval ''" ); +ok( !$c[4], "hasargs false in an eval ''" ); sub { @c = caller(0) } -> (); -is( $c[3], "main::__ANON__", "caller(0) - anonymous subroutine name" ); +is( $c[3], "main::__ANON__", "anonymous subroutine name" ); +ok( $c[4], "hasargs true with anon sub" ); # Bug 20020517.003, used to dump core sub foo { @c = caller(0) } my $fooref = delete $::{foo}; $fooref -> (); -is( $c[3], "(unknown)", "caller(0) - unknown subroutine name" ); +is( $c[3], "(unknown)", "unknown subroutine name" ); +ok( $c[4], "hasargs true with unknown sub" ); + +print "# Tests with caller(1)\n"; sub f { @c = caller(1) } +sub callf { f(); } +callf(); +is( $c[3], "main::callf", "subroutine name" ); +ok( $c[4], "hasargs true with callf()" ); +&callf; +ok( !$c[4], "hasargs false with &callf" ); + eval { f() }; -is( $c[3], "(eval)", "caller(1) - subroutine name in an eval {}" ); +is( $c[3], "(eval)", "subroutine name in an eval {}" ); +ok( !$c[4], "hasargs false in an eval {}" ); eval q{ f() }; -is( $c[3], "(eval)", "caller(1) - subroutine name in an eval ''" ); +is( $c[3], "(eval)", "subroutine name in an eval ''" ); +ok( !$c[4], "hasargs false in an eval ''" ); sub { f() } -> (); -is( $c[3], "main::__ANON__", "caller(1) - anonymous subroutine name" ); +is( $c[3], "main::__ANON__", "anonymous subroutine name" ); +ok( $c[4], "hasargs true with anon sub" ); sub foo2 { f() } my $fooref2 = delete $::{foo2}; $fooref2 -> (); -is( $c[3], "(unknown)", "caller(1) - unknown subroutine name" ); +is( $c[3], "(unknown)", "unknown subroutine name" ); +ok( $c[4], "hasargs true with unknown sub" ); |