1#!./perl 2# Tests for caller() 3 4BEGIN { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7 require './test.pl'; 8} 9 10plan( tests => 20 ); 11 12my @c; 13 14print "# Tests with caller(0)\n"; 15 16@c = caller(0); 17ok( (!@c), "caller(0) in main program" ); 18 19eval { @c = caller(0) }; 20is( $c[3], "(eval)", "subroutine name in an eval {}" ); 21ok( !$c[4], "hasargs false in an eval {}" ); 22 23eval q{ @c = (Caller(0))[3] }; 24is( $c[3], "(eval)", "subroutine name in an eval ''" ); 25ok( !$c[4], "hasargs false in an eval ''" ); 26 27sub { @c = caller(0) } -> (); 28is( $c[3], "main::__ANON__", "anonymous subroutine name" ); 29ok( $c[4], "hasargs true with anon sub" ); 30 31# Bug 20020517.003, used to dump core 32sub foo { @c = caller(0) } 33my $fooref = delete $::{foo}; 34$fooref -> (); 35is( $c[3], "(unknown)", "unknown subroutine name" ); 36ok( $c[4], "hasargs true with unknown sub" ); 37 38print "# Tests with caller(1)\n"; 39 40sub f { @c = caller(1) } 41 42sub callf { f(); } 43callf(); 44is( $c[3], "main::callf", "subroutine name" ); 45ok( $c[4], "hasargs true with callf()" ); 46&callf; 47ok( !$c[4], "hasargs false with &callf" ); 48 49eval { f() }; 50is( $c[3], "(eval)", "subroutine name in an eval {}" ); 51ok( !$c[4], "hasargs false in an eval {}" ); 52 53eval q{ f() }; 54is( $c[3], "(eval)", "subroutine name in an eval ''" ); 55ok( !$c[4], "hasargs false in an eval ''" ); 56 57sub { f() } -> (); 58is( $c[3], "main::__ANON__", "anonymous subroutine name" ); 59ok( $c[4], "hasargs true with anon sub" ); 60 61sub foo2 { f() } 62my $fooref2 = delete $::{foo2}; 63$fooref2 -> (); 64is( $c[3], "(unknown)", "unknown subroutine name" ); 65ok( $c[4], "hasargs true with unknown sub" ); 66