Commit | Line | Data |
---|---|---|
d527ce7c BF |
1 | #!./perl |
2 | # Tests for caller() | |
3 | ||
4 | BEGIN { | |
5 | chdir 't' if -d 't'; | |
d527ce7c | 6 | require './test.pl'; |
624c42e2 | 7 | set_up_inc('../lib'); |
d527ce7c BF |
8 | plan( tests => 18 ); |
9 | } | |
10 | ||
11 | use utf8; | |
12 | use open qw( :utf8 :std ); | |
13 | ||
14 | package main; | |
15 | ||
16 | { | |
17 | local $@; | |
18 | eval 'ok(1);'; | |
19 | ::like $@, qr/Undefined subroutine &main::ok called at/u; | |
20 | } | |
21 | my @c; | |
22 | ||
23 | sub { @c = caller(0) } -> (); | |
24 | ::is( $c[3], "main::__ANON__", "anonymous subroutine name" ); | |
25 | ::ok( $c[4], "hasargs true with anon sub" ); | |
26 | ||
ee95e30c | 27 | # Bug 20020517.003 (#9367), used to dump core |
d527ce7c | 28 | sub foo { @c = caller(0) } |
6881372e FC |
29 | # The subroutine only gets anonymised if it is relying on a real GV |
30 | # for its name. | |
31 | () = *{"foo"}; # with quotes so that the op tree doesn’t reference the GV | |
d527ce7c BF |
32 | my $fooref = delete $main::{foo}; |
33 | $fooref -> (); | |
34 | ::is( $c[3], "main::__ANON__", "deleted subroutine name" ); | |
35 | ::ok( $c[4], "hasargs true with deleted sub" ); | |
36 | ||
37 | print "# Tests with caller(1)\n"; | |
38 | ||
39 | sub f { @c = caller(1) } | |
40 | ||
41 | sub callf { f(); } | |
42 | callf(); | |
43 | ::is( $c[3], "main::callf", "subroutine name" ); | |
44 | ::ok( $c[4], "hasargs true with callf()" ); | |
45 | &callf; | |
46 | ::ok( !$c[4], "hasargs false with &callf" ); | |
47 | ||
48 | eval { f() }; | |
49 | ::is( $c[3], "(eval)", "subroutine name in an eval {}" ); | |
50 | ::ok( !$c[4], "hasargs false in an eval {}" ); | |
51 | ||
52 | eval q{ f() }; | |
53 | ::is( $c[3], "(eval)", "subroutine name in an eval ''" ); | |
54 | ::ok( !$c[4], "hasargs false in an eval ''" ); | |
55 | ||
56 | sub { f() } -> (); | |
57 | ::is( $c[3], "main::__ANON__", "anonymous subroutine name" ); | |
58 | ::ok( $c[4], "hasargs true with anon sub" ); | |
59 | ||
60 | sub foo2 { f() } | |
6881372e | 61 | () = *{"foo2"}; # see foo notes above |
d527ce7c BF |
62 | my $fooref2 = delete $main::{foo2}; |
63 | $fooref2 -> (); | |
64 | ::is( $c[3], "main::__ANON__", "deleted subroutine name" ); | |
65 | ::ok( $c[4], "hasargs true with deleted sub" ); | |
66 | ||
67 | sub pb { return (caller(0))[3] } | |
68 | ||
69 | ::is( eval 'pb()', 'main::pb', "actually return the right function name" ); | |
70 | ||
71 | my $saved_perldb = $^P; | |
72 | $^P = 16; | |
73 | $^P = $saved_perldb; | |
74 | ||
75 | ::is( eval 'pb()', 'main::pb', 'actually return the right function name even if $^P had been on at some point' ); |