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