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