Filename | /usr/lib/x86_64-linux-gnu/perl/5.20/attributes.pm |
Statements | Executed 23 statements in 1.05ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 20µs | 36µs | import | attributes::
1 | 1 | 1 | 16µs | 27µs | BEGIN@9 | attributes::
1 | 1 | 1 | 6µs | 8µs | _modify_attrs_and_deprecate | attributes::
2 | 2 | 1 | 4µs | 4µs | CORE:qr (opcode) | attributes::
1 | 1 | 1 | 2µs | 2µs | reftype (xsub) | attributes::
1 | 1 | 1 | 2µs | 2µs | _modify_attrs (xsub) | 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.23; | ||
4 | |||||
5 | 1 | 1µs | @EXPORT_OK = qw(get reftype); | ||
6 | 1 | 200ns | @EXPORT = (); | ||
7 | 1 | 5µs | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); | ||
8 | |||||
9 | 2 | 813µs | 2 | 38µs | # spent 27µs (16+11) within attributes::BEGIN@9 which was called:
# once (16µs+11µs) by DynaLoader::BEGIN@92 at line 9 # spent 27µs making 1 call to attributes::BEGIN@9
# spent 11µ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 | 11µs | 1 | 3µs | $deprecated{CODE} = qr/\A-?(locked)\z/; # spent 3µs making 1 call to attributes::CORE:qr |
23 | 1 | 4µs | 1 | 900ns | $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} # spent 900ns making 1 call to attributes::CORE:qr |
24 | = qr/\A-?(unique)\z/; | ||||
25 | |||||
26 | # spent 8µs (6+2) within attributes::_modify_attrs_and_deprecate which was called:
# once (6µs+2µs) by attributes::import at line 81 | ||||
27 | 1 | 400ns | my $svtype = shift; | ||
28 | # Now that we've removed handling of locked from the XS code, we need to | ||||
29 | # remove it here, else it ends up in @badattrs. (If we do the deprecation in | ||||
30 | # XS, we can't control the warning based on *our* caller's lexical settings, | ||||
31 | # and the warned line is in this package) | ||||
32 | grep { | ||||
33 | 1 | 10µs | 1 | 2µs | $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { # spent 2µs making 1 call to attributes::_modify_attrs |
34 | require warnings; | ||||
35 | warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); | ||||
36 | 0; | ||||
37 | } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do { | ||||
38 | require warnings; | ||||
39 | warnings::warnif( | ||||
40 | 'misc', | ||||
41 | "lvalue attribute " | ||||
42 | . (/^-/ ? "removed from" : "applied to") | ||||
43 | . " already-defined subroutine" | ||||
44 | ); | ||||
45 | 0; | ||||
46 | } : 1 | ||||
47 | } _modify_attrs(@_); | ||||
48 | } | ||||
49 | |||||
50 | # spent 36µs (20+17) within attributes::import which was called:
# once (20µs+17µs) by DynaLoader::BEGIN@92 at line 92 of XSLoader.pm | ||||
51 | 1 | 1µs | @_ > 2 && ref $_[2] or do { | ||
52 | require Exporter; | ||||
53 | goto &Exporter::import; | ||||
54 | }; | ||||
55 | 1 | 1µs | my (undef,$home_stash,$svref,@attrs) = @_; | ||
56 | |||||
57 | 1 | 7µs | 1 | 2µs | my $svtype = uc reftype($svref); # spent 2µs making 1 call to attributes::reftype |
58 | 1 | 100ns | my $pkgmeth; | ||
59 | 1 | 12µs | 1 | 6µs | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 6µs making 1 call to UNIVERSAL::can |
60 | if defined $home_stash && $home_stash ne ''; | ||||
61 | 1 | 200ns | my @badattrs; | ||
62 | 1 | 300ns | if ($pkgmeth) { | ||
63 | my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); | ||||
64 | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); | ||||
65 | if (!@badattrs && @pkgattrs) { | ||||
66 | require warnings; | ||||
67 | return unless warnings::enabled('reserved'); | ||||
68 | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; | ||||
69 | if (@pkgattrs) { | ||||
70 | for my $attr (@pkgattrs) { | ||||
71 | $attr =~ s/\(.+\z//s; | ||||
72 | } | ||||
73 | my $s = ((@pkgattrs == 1) ? '' : 's'); | ||||
74 | carp "$svtype package attribute$s " . | ||||
75 | "may clash with future reserved word$s: " . | ||||
76 | join(' : ' , @pkgattrs); | ||||
77 | } | ||||
78 | } | ||||
79 | } | ||||
80 | else { | ||||
81 | 1 | 2µs | 1 | 8µs | @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 8µs making 1 call to attributes::_modify_attrs_and_deprecate |
82 | } | ||||
83 | 1 | 3µs | if (@badattrs) { | ||
84 | croak "Invalid $svtype attribute" . | ||||
85 | (( @badattrs == 1 ) ? '' : 's') . | ||||
86 | ": " . | ||||
87 | join(' : ', @badattrs); | ||||
88 | } | ||||
89 | } | ||||
90 | |||||
91 | sub get ($) { | ||||
92 | @_ == 1 && ref $_[0] or | ||||
93 | croak 'Usage: '.__PACKAGE__.'::get $ref'; | ||||
94 | my $svref = shift; | ||||
95 | my $svtype = uc reftype($svref); | ||||
96 | my $stash = _guess_stash($svref); | ||||
97 | $stash = caller unless defined $stash; | ||||
98 | my $pkgmeth; | ||||
99 | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") | ||||
100 | if defined $stash && $stash ne ''; | ||||
101 | return $pkgmeth ? | ||||
102 | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : | ||||
103 | (_fetch_attrs($svref)) | ||||
104 | ; | ||||
105 | } | ||||
106 | |||||
107 | sub require_version { goto &UNIVERSAL::VERSION } | ||||
108 | |||||
109 | 1 | 800ns | require XSLoader; | ||
110 | 1 | 170µs | 1 | 0s | XSLoader::load(); # spent 162µs making 1 call to XSLoader::load, recursion: max depth 1, sum of overlapping time 162µs |
111 | |||||
112 | 1 | 7µs | 1; | ||
113 | __END__ | ||||
sub attributes::CORE:qr; # opcode | |||||
# spent 2µs within attributes::_modify_attrs which was called:
# once (2µs+0s) by attributes::_modify_attrs_and_deprecate at line 33 | |||||
# spent 2µs within attributes::reftype which was called:
# once (2µs+0s) by attributes::import at line 57 |