t/op/caller.t

   1 #!./perl
   2 # Tests for caller()
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7     require './test.pl';
   8 }
   9
  10 plan( tests => 9 );
  11
  12 my @c;
  13
  14 @c = caller(0);
  15 ok( (!@c), "caller(0) in main program" );
  16
  17 eval { @c = caller(0) };
  18 is( $c[3], "(eval)", "caller(0) - subroutine name in an eval {}" );
  19
  20 eval q{ @c = (Caller(0))[3] };
  21 is( $c[3], "(eval)", "caller(0) - subroutine name in an eval ''" );
  22
  23 sub { @c = caller(0) } -> ();
  24 is( $c[3], "main::__ANON__", "caller(0) - anonymous subroutine name" );
  25
  26 # Bug 20020517.003, used to dump core
  27 sub foo { @c = caller(0) }
  28 my $fooref = delete $::{foo};
  29 $fooref -> ();
  30 is( $c[3], "(unknown)", "caller(0) - unknown subroutine name" );
  31
  32 sub f { @c = caller(1) }
  33
  34 eval { f() };
  35 is( $c[3], "(eval)", "caller(1) - subroutine name in an eval {}" );
  36
  37 eval q{ f() };
  38 is( $c[3], "(eval)", "caller(1) - subroutine name in an eval ''" );
  39
  40 sub { f() } -> ();
  41 is( $c[3], "main::__ANON__", "caller(1) - anonymous subroutine name" );
  42
  43 sub foo2 { f() }
  44 my $fooref2 = delete $::{foo2};
  45 $fooref2 -> ();
  46 is( $c[3], "(unknown)", "caller(1) - unknown subroutine name" );