This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
de314b0a31319ced2eb008e2e55fc7f2b37423c5
[perl5.git] / t / uni / caller.t
1 #!./perl
2 # Tests for caller()
3
4 BEGIN {
5     chdir 't' if -d 't';
6     require './test.pl';
7     set_up_inc('../lib');
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
27 # Bug 20020517.003 (#9367), used to dump core
28 sub foo { @c = caller(0) }
29 my $fooref = delete $main::{foo};
30 $fooref -> ();
31 ::is( $c[3], "main::__ANON__", "deleted subroutine name" );
32 ::ok( $c[4], "hasargs true with deleted sub" );
33
34 print "# Tests with caller(1)\n";
35
36 sub f { @c = caller(1) }
37
38 sub callf { f(); }
39 callf();
40 ::is( $c[3], "main::callf", "subroutine name" );
41 ::ok( $c[4], "hasargs true with callf()" );
42 &callf;
43 ::ok( !$c[4], "hasargs false with &callf" );
44
45 eval { f() };
46 ::is( $c[3], "(eval)", "subroutine name in an eval {}" );
47 ::ok( !$c[4], "hasargs false in an eval {}" );
48
49 eval q{ f() };
50 ::is( $c[3], "(eval)", "subroutine name in an eval ''" );
51 ::ok( !$c[4], "hasargs false in an eval ''" );
52
53 sub { f() } -> ();
54 ::is( $c[3], "main::__ANON__", "anonymous subroutine name" );
55 ::ok( $c[4], "hasargs true with anon sub" );
56
57 sub foo2 { f() }
58 my $fooref2 = delete $main::{foo2};
59 $fooref2 -> ();
60 ::is( $c[3], "main::__ANON__", "deleted subroutine name" );
61 ::ok( $c[4], "hasargs true with deleted sub" );
62
63 sub pb { return (caller(0))[3] }
64
65 ::is( eval 'pb()', 'main::pb', "actually return the right function name" );
66
67 my $saved_perldb = $^P;
68 $^P = 16;
69 $^P = $saved_perldb;
70
71 ::is( eval 'pb()', 'main::pb', 'actually return the right function name even if $^P had been on at some point' );