| Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/5.14.1/x86_64-linux-thread-multi/attributes.pm |
| Statements | Executed 69 statements in 4.05ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 3 | 3 | 3 | 359µs | 2.54ms | attributes::import |
| 3 | 1 | 1 | 176µs | 217µs | attributes::_modify_attrs_and_deprecate |
| 1 | 1 | 1 | 70µs | 87µs | attributes::BEGIN@9 |
| 6 | 2 | 1 | 36µs | 36µs | attributes::CORE:match (opcode) |
| 2 | 2 | 1 | 33µs | 33µs | attributes::CORE:qr (opcode) |
| 3 | 1 | 1 | 20µs | 20µs | attributes::reftype (xsub) |
| 3 | 1 | 1 | 19µs | 19µs | attributes::CORE:regcomp (opcode) |
| 3 | 1 | 1 | 11µs | 11µs | attributes::_modify_attrs (xsub) |
| 0 | 0 | 0 | 0s | 0s | attributes::carp |
| 0 | 0 | 0 | 0s | 0s | attributes::croak |
| 0 | 0 | 0 | 0s | 0s | attributes::get |
| 0 | 0 | 0 | 0s | 0s | attributes::require_version |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package attributes; | ||||
| 2 | |||||
| 3 | 1 | 2µs | our $VERSION = 0.14; | ||
| 4 | |||||
| 5 | 1 | 6µs | @EXPORT_OK = qw(get reftype); | ||
| 6 | 1 | 1µs | @EXPORT = (); | ||
| 7 | 1 | 11µs | %EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); | ||
| 8 | |||||
| 9 | 2 | 2.50ms | 2 | 104µs | # spent 87µs (70+17) within attributes::BEGIN@9 which was called:
# once (70µs+17µs) by Attribute::Handlers::BEGIN@110 at line 9 # spent 87µs making 1 call to attributes::BEGIN@9
# spent 17µ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 | 700ns | my %deprecated; | ||
| 22 | 1 | 57µs | 1 | 28µs | $deprecated{CODE} = qr/\A-?(locked)\z/; # spent 28µs making 1 call to attributes::CORE:qr |
| 23 | 1 | 17µs | 1 | 5µs | $deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} # spent 5µs making 1 call to attributes::CORE:qr |
| 24 | = qr/\A-?(unique)\z/; | ||||
| 25 | |||||
| 26 | # spent 217µs (176+41) within attributes::_modify_attrs_and_deprecate which was called 3 times, avg 72µs/call:
# 3 times (176µs+41µs) by attributes::import at line 54, avg 72µs/call | ||||
| 27 | 9 | 200µs | 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 | 9 | 41µs | $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { # spent 19µs making 3 calls to attributes::CORE:regcomp, avg 6µs/call
# spent 11µs making 3 calls to attributes::_modify_attrs, avg 4µs/call
# spent 11µs making 3 calls to attributes::CORE:match, avg 4µs/call | ||
| 34 | require warnings; | ||||
| 35 | warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); | ||||
| 36 | 0; | ||||
| 37 | } : 1 | ||||
| 38 | } _modify_attrs(@_); | ||||
| 39 | } | ||||
| 40 | |||||
| 41 | # spent 2.54ms (359µs+2.18) within attributes::import which was called 3 times, avg 848µs/call:
# once (112µs+862µs) by App::Rad::Help::BEGIN@59 at line 59 of App/Rad/Help.pm
# once (106µs+685µs) by main::BEGIN@69 at line 69 of bin/dpath
# once (142µs+638µs) by Attribute::Handlers::BEGIN@110 at line 110 of Attribute/Handlers.pm | ||||
| 42 | 48 | 481µs | @_ > 2 && ref $_[2] or do { | ||
| 43 | require Exporter; | ||||
| 44 | goto &Exporter::import; | ||||
| 45 | }; | ||||
| 46 | my (undef,$home_stash,$svref,@attrs) = @_; | ||||
| 47 | |||||
| 48 | 3 | 20µs | my $svtype = uc reftype($svref); # spent 20µs making 3 calls to attributes::reftype, avg 7µs/call | ||
| 49 | my $pkgmeth; | ||||
| 50 | 3 | 62µs | $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 62µs making 3 calls to UNIVERSAL::can, avg 21µs/call | ||
| 51 | if defined $home_stash && $home_stash ne ''; | ||||
| 52 | my @badattrs; | ||||
| 53 | if ($pkgmeth) { | ||||
| 54 | 3 | 217µs | my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 217µs making 3 calls to attributes::_modify_attrs_and_deprecate, avg 72µs/call | ||
| 55 | 3 | 728µs | @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); # spent 663µs making 2 calls to Attribute::Handlers::__ANON__[Attribute/Handlers.pm:195], avg 331µs/call
# spent 66µs making 1 call to Attribute::Handlers::_TEST_::MODIFY_CODE_ATTRIBUTES | ||
| 56 | if (!@badattrs && @pkgattrs) { | ||||
| 57 | require warnings; | ||||
| 58 | 3 | 1.13ms | return unless warnings::enabled('reserved'); # spent 1.13ms making 3 calls to warnings::enabled, avg 378µs/call | ||
| 59 | 3 | 25µs | @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; # spent 25µs making 3 calls to attributes::CORE:match, avg 8µs/call | ||
| 60 | if (@pkgattrs) { | ||||
| 61 | for my $attr (@pkgattrs) { | ||||
| 62 | $attr =~ s/\(.+\z//s; | ||||
| 63 | } | ||||
| 64 | my $s = ((@pkgattrs == 1) ? '' : 's'); | ||||
| 65 | carp "$svtype package attribute$s " . | ||||
| 66 | "may clash with future reserved word$s: " . | ||||
| 67 | join(' : ' , @pkgattrs); | ||||
| 68 | } | ||||
| 69 | } | ||||
| 70 | } | ||||
| 71 | else { | ||||
| 72 | @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); | ||||
| 73 | } | ||||
| 74 | if (@badattrs) { | ||||
| 75 | croak "Invalid $svtype attribute" . | ||||
| 76 | (( @badattrs == 1 ) ? '' : 's') . | ||||
| 77 | ": " . | ||||
| 78 | join(' : ', @badattrs); | ||||
| 79 | } | ||||
| 80 | } | ||||
| 81 | |||||
| 82 | sub get ($) { | ||||
| 83 | @_ == 1 && ref $_[0] or | ||||
| 84 | croak 'Usage: '.__PACKAGE__.'::get $ref'; | ||||
| 85 | my $svref = shift; | ||||
| 86 | my $svtype = uc reftype($svref); | ||||
| 87 | my $stash = _guess_stash($svref); | ||||
| 88 | $stash = caller unless defined $stash; | ||||
| 89 | my $pkgmeth; | ||||
| 90 | $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") | ||||
| 91 | if defined $stash && $stash ne ''; | ||||
| 92 | return $pkgmeth ? | ||||
| 93 | (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : | ||||
| 94 | (_fetch_attrs($svref)) | ||||
| 95 | ; | ||||
| 96 | } | ||||
| 97 | |||||
| 98 | sub require_version { goto &UNIVERSAL::VERSION } | ||||
| 99 | |||||
| 100 | 1 | 2µs | require XSLoader; | ||
| 101 | 1 | 739µs | 1 | 711µs | XSLoader::load(); # spent 711µs making 1 call to XSLoader::load |
| 102 | |||||
| 103 | 1 | 38µs | 1; | ||
| 104 | __END__ | ||||
sub attributes::CORE:match; # opcode | |||||
sub attributes::CORE:qr; # opcode | |||||
# spent 19µs within attributes::CORE:regcomp which was called 3 times, avg 6µs/call:
# 3 times (19µs+0s) by attributes::_modify_attrs_and_deprecate at line 33, avg 6µs/call | |||||
# spent 11µs within attributes::_modify_attrs which was called 3 times, avg 4µs/call:
# 3 times (11µs+0s) by attributes::_modify_attrs_and_deprecate at line 33, avg 4µs/call | |||||
# spent 20µs within attributes::reftype which was called 3 times, avg 7µs/call:
# 3 times (20µs+0s) by attributes::import at line 48, avg 7µs/call |