1N/A#!./perl
1N/A# Tests for caller()
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require './test.pl';
1N/A}
1N/A
1N/Aplan( tests => 20 );
1N/A
1N/Amy @c;
1N/A
1N/Aprint "# Tests with caller(0)\n";
1N/A
1N/A@c = caller(0);
1N/Aok( (!@c), "caller(0) in main program" );
1N/A
1N/Aeval { @c = caller(0) };
1N/Ais( $c[3], "(eval)", "subroutine name in an eval {}" );
1N/Aok( !$c[4], "hasargs false in an eval {}" );
1N/A
1N/Aeval q{ @c = (Caller(0))[3] };
1N/Ais( $c[3], "(eval)", "subroutine name in an eval ''" );
1N/Aok( !$c[4], "hasargs false in an eval ''" );
1N/A
1N/Asub { @c = caller(0) } -> ();
1N/Ais( $c[3], "main::__ANON__", "anonymous subroutine name" );
1N/Aok( $c[4], "hasargs true with anon sub" );
1N/A
1N/A# Bug 20020517.003, used to dump core
1N/Asub foo { @c = caller(0) }
1N/Amy $fooref = delete $::{foo};
1N/A$fooref -> ();
1N/Ais( $c[3], "(unknown)", "unknown subroutine name" );
1N/Aok( $c[4], "hasargs true with unknown sub" );
1N/A
1N/Aprint "# Tests with caller(1)\n";
1N/A
1N/Asub f { @c = caller(1) }
1N/A
1N/Asub callf { f(); }
1N/Acallf();
1N/Ais( $c[3], "main::callf", "subroutine name" );
1N/Aok( $c[4], "hasargs true with callf()" );
1N/A&callf;
1N/Aok( !$c[4], "hasargs false with &callf" );
1N/A
1N/Aeval { f() };
1N/Ais( $c[3], "(eval)", "subroutine name in an eval {}" );
1N/Aok( !$c[4], "hasargs false in an eval {}" );
1N/A
1N/Aeval q{ f() };
1N/Ais( $c[3], "(eval)", "subroutine name in an eval ''" );
1N/Aok( !$c[4], "hasargs false in an eval ''" );
1N/A
1N/Asub { f() } -> ();
1N/Ais( $c[3], "main::__ANON__", "anonymous subroutine name" );
1N/Aok( $c[4], "hasargs true with anon sub" );
1N/A
1N/Asub foo2 { f() }
1N/Amy $fooref2 = delete $::{foo2};
1N/A$fooref2 -> ();
1N/Ais( $c[3], "(unknown)", "unknown subroutine name" );
1N/Aok( $c[4], "hasargs true with unknown sub" );