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