1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
# test determination of subroutine caller in unusual cases
{
my $a = time;
# calls to TIESCALAR aren't seen by perl < 5.8.9 and 5.10.1
sub MyTie::TIESCALAR { bless {}, shift; }
sub MyTie::FETCH { }
sub MyTie::STORE { }
}
tie my $tied, 'MyTie', 42; # TIESCALAR
$tied = 1; # STORE
if ($tied) { 1 } # FETCH
# test dying from an xsub
require Devel::NYTProf::Test;
eval { Devel::NYTProf::Test::example_xsub(0, "die") };
# test dying from an xsub where the surrounding eval is an
# argument to a sub call. This used to coredump.
sub sub1 { $_[0] }
sub1 eval { Devel::NYTProf::Test::example_xsub(0, "die") };
# test sub calls (xs and perl) from within a sort block
sub sub2 { $_[0] }
my @a = sort {
Devel::NYTProf::Test::example_xsub();
sub2($a) <=> sub2($b);
} (1,3,2);
# test sub call as a sort block
sub sub3 { $_[0] } # XXX not recorded due to limitation of perl
my @b = sort \&sub3, 3, 1, 2;
# test sub call from a subst
sub sub4 { $_[0] }
my $a = "abcbd";
$a =~ s/b/sub4(uc($1))/ge;
exit 0;
|
