1use strict;
2use warnings;
3
4BEGIN { $^P |= 0x210 }
5
6use Test::More tests => 18;
7
8use B::Deparse;
9use Sub::Util qw( subname set_subname );
10
11{
12  sub localfunc {}
13  sub fully::qualified::func {}
14
15  is(subname(\&subname), "Sub::Util::subname",
16    'subname of \&subname');
17  is(subname(\&localfunc), "main::localfunc",
18    'subname of \&localfunc');
19  is(subname(\&fully::qualified::func), "fully::qualified::func",
20    'subname of \&fully::qualfied::func');
21
22  # Because of the $^P debug flag, we'll get [file:line] as well
23  like(subname(sub {}), qr/^main::__ANON__\[.+:\d+\]$/, 'subname of anon sub');
24
25  ok(!eval { subname([]) }, 'subname [] dies');
26}
27
28my $x = set_subname foo => sub { (caller 0)[3] };
29my $line = __LINE__ - 1;
30my $file = __FILE__;
31my $anon = $DB::sub{"main::__ANON__[${file}:${line}]"};
32
33is($x->(), "main::foo");
34
35{
36  package Blork;
37
38  use Sub::Util qw( set_subname );
39
40  set_subname " Bar!", $x;
41  ::is($x->(), "Blork:: Bar!");
42
43  set_subname "Foo::Bar::Baz", $x;
44  ::is($x->(), "Foo::Bar::Baz");
45
46  set_subname "set_subname (dynamic $_)", \&set_subname  for 1 .. 3;
47
48  for (4 .. 5) {
49      set_subname "Dynamic $_", $x;
50      ::is($x->(), "Blork::Dynamic $_");
51  }
52
53  ::is($DB::sub{"main::foo"}, $anon);
54
55  for (4 .. 5) {
56      ::is($DB::sub{"Blork::Dynamic $_"}, $anon);
57  }
58
59  for ("Blork:: Bar!", "Foo::Bar::Baz") {
60      ::is($DB::sub{$_}, $anon);
61  }
62}
63
64# RT42725
65{
66  my $source = eval {
67      B::Deparse->new->coderef2text(set_subname foo => sub{ @_ });
68  };
69
70  ok !$@;
71
72  like $source, qr/\@\_/;
73}
74
75# subname of set_subname
76{
77  is(subname(set_subname "my-scary-name-here", sub {}), "main::my-scary-name-here",
78    'subname of set_subname');
79}
80
81# vim: ft=perl
82