Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/x86_64-linux/attributes.pm |
Statements | Executed 273 statements in 936µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
14 | 14 | 4 | 244µs | 1.28ms | import | attributes::
14 | 1 | 1 | 83µs | 110µs | _modify_attrs_and_deprecate | attributes::
26 | 2 | 1 | 13µs | 13µs | CORE:match (opcode) | attributes::
13 | 1 | 1 | 13µs | 13µs | CORE:regcomp (opcode) | attributes::
14 | 1 | 1 | 9µs | 9µs | reftype (xsub) | attributes::
14 | 1 | 1 | 9µs | 9µs | _modify_attrs (xsub) | attributes::
1 | 1 | 1 | 9µs | 10µs | BEGIN@9 | attributes::
2 | 2 | 1 | 3µs | 3µs | CORE:qr (opcode) | attributes::
0 | 0 | 0 | 0s | 0s | carp | attributes::
0 | 0 | 0 | 0s | 0s | croak | attributes::
0 | 0 | 0 | 0s | 0s | get | attributes::
0 | 0 | 0 | 0s | 0s | require_version | attributes::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package attributes; | ||||
2 | |||||
3 | 1 | 300ns | our $VERSION = 0.27; | ||
4 | |||||
5 | 1 | 700ns | @EXPORT_OK = qw(get reftype); | ||
6 | 1 | 100ns | @EXPORT = (); | ||
7 | 1 | 2µs | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); | ||
8 | |||||
9 | 2 | 400µs | 2 | 12µs | # spent 10µs (9+1) within attributes::BEGIN@9 which was called:
# once (9µs+1µs) by Attribute::Handlers::BEGIN@114 at line 9 # spent 10µs making 1 call to attributes::BEGIN@9
# spent 2µs making 1 call to strict::import |
10 | |||||
11 | sub croak { | ||||
12 | require Carp; | ||||
13 | goto &Carp::croak; | ||||
14 | } | ||||
15 | |||||
16 | sub carp { | ||||
17 | require Carp; | ||||
18 | goto &Carp::carp; | ||||
19 | } | ||||
20 | |||||
21 | 1 | 200ns | my %deprecated; | ||
22 | 1 | 7µs | 1 | 2µs | $deprecated{CODE} = qr/\A-?(locked)\z/; # spent 2µs making 1 call to attributes::CORE:qr |
23 | $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} | ||||
24 | 1 | 2µs | 1 | 400ns | = qr/\A-?(unique)\z/; # spent 400ns making 1 call to attributes::CORE:qr |
25 | |||||
26 | 1 | 2µs | my %msg = ( | ||
27 | lvalue => 'lvalue attribute applied to already-defined subroutine', | ||||
28 | -lvalue => 'lvalue attribute removed from already-defined subroutine', | ||||
29 | const => 'Useless use of attribute "const"', | ||||
30 | ); | ||||
31 | |||||
32 | # spent 110µs (83+27) within attributes::_modify_attrs_and_deprecate which was called 14 times, avg 8µs/call:
# 14 times (83µs+27µs) by attributes::import at line 67, avg 8µs/call | ||||
33 | 14 | 4µs | my $svtype = shift; | ||
34 | # Now that we've removed handling of locked from the XS code, we need to | ||||
35 | # remove it here, else it ends up in @badattrs. (If we do the deprecation in | ||||
36 | # XS, we can't control the warning based on *our* caller's lexical settings, | ||||
37 | # and the warned line is in this package) | ||||
38 | grep { | ||||
39 | 14 | 54µs | 14 | 9µs | $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { # spent 9µs making 14 calls to attributes::_modify_attrs, avg 657ns/call |
40 | require warnings; | ||||
41 | warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); | ||||
42 | 0; | ||||
43 | 13 | 59µs | 26 | 18µs | } : $svtype eq 'CODE' && exists $msg{$_} ? do { # spent 13µs making 13 calls to attributes::CORE:regcomp, avg 977ns/call
# spent 5µs making 13 calls to attributes::CORE:match, avg 377ns/call |
44 | require warnings; | ||||
45 | warnings::warnif( | ||||
46 | 'misc', | ||||
47 | $msg{$_} | ||||
48 | ); | ||||
49 | 0; | ||||
50 | } : 1 | ||||
51 | } _modify_attrs(@_); | ||||
52 | } | ||||
53 | |||||
54 | # spent 1.28ms (244µs+1.04) within attributes::import which was called 14 times, avg 92µs/call:
# once (18µs+136µs) by App::Rad::Help::BEGIN@59 at line 59 of App/Rad/Help.pm
# once (22µs+114µs) by main::BEGIN@229 at line 229 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (21µs+96µs) by Attribute::Handlers::BEGIN@114 at line 114 of Attribute/Handlers.pm
# once (16µs+75µs) by main::BEGIN@237 at line 237 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (13µs+72µs) by main::BEGIN@277 at line 277 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (15µs+66µs) by main::BEGIN@253 at line 253 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (13µs+66µs) by main::BEGIN@245 at line 245 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (53µs+27µs) by DynaLoader::BEGIN@94 at line 94 of XSLoader.pm
# once (12µs+66µs) by main::BEGIN@304 at line 304 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (12µs+65µs) by main::BEGIN@286 at line 286 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (12µs+65µs) by main::BEGIN@312 at line 312 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (12µs+64µs) by main::BEGIN@269 at line 269 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (12µs+64µs) by main::BEGIN@295 at line 295 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
# once (13µs+63µs) by main::BEGIN@261 at line 261 of /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage | ||||
55 | 14 | 9µs | @_ > 2 && ref $_[2] or do { | ||
56 | require Exporter; | ||||
57 | goto &Exporter::import; | ||||
58 | }; | ||||
59 | 14 | 12µs | my (undef,$home_stash,$svref,@attrs) = @_; | ||
60 | |||||
61 | 14 | 42µs | 14 | 9µs | my $svtype = uc reftype($svref); # spent 9µs making 14 calls to attributes::reftype, avg 664ns/call |
62 | 14 | 1µs | my $pkgmeth; | ||
63 | 14 | 52µs | 14 | 23µs | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 23µs making 14 calls to UNIVERSAL::can, avg 2µs/call |
64 | if defined $home_stash && $home_stash ne ''; | ||||
65 | 14 | 23µs | my @badattrs; | ||
66 | 14 | 6µs | if ($pkgmeth) { | ||
67 | 14 | 16µs | 14 | 110µs | my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 110µs making 14 calls to attributes::_modify_attrs_and_deprecate, avg 8µs/call |
68 | 14 | 18µs | 14 | 340µs | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); # spent 337µs making 13 calls to Attribute::Handlers::__ANON__[Attribute/Handlers.pm:199], avg 26µs/call
# spent 2µs making 1 call to Attribute::Handlers::_TEST_::MODIFY_CODE_ATTRIBUTES |
69 | 14 | 8µs | if (!@badattrs && @pkgattrs) { | ||
70 | 13 | 4µs | require warnings; | ||
71 | 13 | 10µs | 13 | 548µs | return unless warnings::enabled('reserved'); # spent 548µs making 13 calls to warnings::enabled, avg 42µs/call |
72 | 26 | 34µs | 13 | 8µs | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; # spent 8µs making 13 calls to attributes::CORE:match, avg 646ns/call |
73 | 13 | 2µs | if (@pkgattrs) { | ||
74 | for my $attr (@pkgattrs) { | ||||
75 | $attr =~ s/\(.+\z//s; | ||||
76 | } | ||||
77 | my $s = ((@pkgattrs == 1) ? '' : 's'); | ||||
78 | carp "$svtype package attribute$s " . | ||||
79 | "may clash with future reserved word$s: " . | ||||
80 | join(' : ' , @pkgattrs); | ||||
81 | } | ||||
82 | } | ||||
83 | } | ||||
84 | else { | ||||
85 | @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); | ||||
86 | } | ||||
87 | 14 | 31µs | if (@badattrs) { | ||
88 | croak "Invalid $svtype attribute" . | ||||
89 | (( @badattrs == 1 ) ? '' : 's') . | ||||
90 | ": " . | ||||
91 | join(' : ', @badattrs); | ||||
92 | } | ||||
93 | } | ||||
94 | |||||
95 | sub get ($) { | ||||
96 | @_ == 1 && ref $_[0] or | ||||
97 | croak 'Usage: '.__PACKAGE__.'::get $ref'; | ||||
98 | my $svref = shift; | ||||
99 | my $svtype = uc reftype($svref); | ||||
100 | my $stash = _guess_stash($svref); | ||||
101 | $stash = caller unless defined $stash; | ||||
102 | my $pkgmeth; | ||||
103 | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") | ||||
104 | if defined $stash && $stash ne ''; | ||||
105 | return $pkgmeth ? | ||||
106 | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : | ||||
107 | (_fetch_attrs($svref)) | ||||
108 | ; | ||||
109 | } | ||||
110 | |||||
111 | sub require_version { goto &UNIVERSAL::VERSION } | ||||
112 | |||||
113 | 1 | 400ns | require XSLoader; | ||
114 | 1 | 130µs | 1 | 124µs | XSLoader::load(); # spent 124µs making 1 call to XSLoader::load |
115 | |||||
116 | 1 | 6µs | 1; | ||
117 | __END__ | ||||
sub attributes::CORE:match; # opcode | |||||
sub attributes::CORE:qr; # opcode | |||||
# spent 13µs within attributes::CORE:regcomp which was called 13 times, avg 977ns/call:
# 13 times (13µs+0s) by attributes::_modify_attrs_and_deprecate at line 43, avg 977ns/call | |||||
# spent 9µs within attributes::_modify_attrs which was called 14 times, avg 657ns/call:
# 14 times (9µs+0s) by attributes::_modify_attrs_and_deprecate at line 39, avg 657ns/call | |||||
# spent 9µs within attributes::reftype which was called 14 times, avg 664ns/call:
# 14 times (9µs+0s) by attributes::import at line 61, avg 664ns/call |