Profile of attributes.pm

Filename	/usr/lib64/perl5/5.16.0/x86_64-linux/attributes.pm
Statements	Executed 23 statements in 18.8ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	121µs	206µs	attributes::::importattributes::import
1	1	1	97µs	204µs	attributes::::BEGIN@9attributes::BEGIN@9
1	1	1	43µs	48µs	attributes::_modify_attrs_and_deprecate
2	2	1	39µs	39µs	attributes::::CORE:qrattributes::CORE:qr (opcode)
1	1	1	6µs	6µs	attributes::::reftypeattributes::reftype (xsub)
1	1	1	6µs	6µs	attributes::::_modify_attrsattributes::_modify_attrs (xsub)
0	0	0	0s	0s	attributes::::carpattributes::carp
0	0	0	0s	0s	attributes::::croakattributes::croak
0	0	0	0s	0s	attributes::::getattributes::get
0	0	0	0s	0s	attributes::::require_versionattributes::require_version

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package attributes;
2
3	1	2µs			our $VERSION = 0.19;
4
5	1	8µs			@EXPORT_OK = qw(get reftype);
6	1	1µs			@EXPORT = ();
7	1	14µs			%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8
9	2	3.83ms	2	312µs	# spent 204µs (97+107) within attributes::BEGIN@9 which was called: # once (97µs+107µs) by DynaLoader::BEGIN@92 at line 9 use strict; # spent 204µs making 1 call to attributes::BEGIN@9 # spent 107µ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	1µs			my %deprecated;
22	1	76µs	1	30µs	$deprecated{CODE} = qr/\A-?(locked)\z/; # spent 30µs making 1 call to attributes::CORE:qr
23	1	29µs	1	9µs	$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} # spent 9µs making 1 call to attributes::CORE:qr
24					= qr/\A-?(unique)\z/;
25
26					# spent 48µs (43+6) within attributes::_modify_attrs_and_deprecate which was called: # once (43µs+6µs) by attributes::import at line 81 sub _modify_attrs_and_deprecate {
27	1	5µ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	1	53µs	1	6µs	$deprecated{$svtype} && /$deprecated{$svtype}/ ? do { # spent 6µ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 206µs (121+84) within attributes::import which was called: # once (121µs+84µs) by DynaLoader::BEGIN@92 at line 92 of XSLoader.pm sub import {
51	1	8µs			@_ > 2 && ref $_[2] or do {
52					require Exporter;
53					goto &Exporter::import;
54					};
55	1	8µs			my (undef,$home_stash,$svref,@attrs) = @_;
56
57	1	41µs	1	6µs	my $svtype = uc reftype($svref); # spent 6µs making 1 call to attributes::reftype
58	1	900ns			my $pkgmeth;
59	1	58µs	1	30µs	$pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 30µs making 1 call to UNIVERSAL::can
60					if defined $home_stash && $home_stash ne '';
61	1	1µs			my @badattrs;
62	1	3µs			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	14µs	1	48µs	@badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 48µs making 1 call to attributes::_modify_attrs_and_deprecate
82					}
83	1	22µ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	3µs			require XSLoader;
110	1	14.6ms	1	0s	XSLoader::load(); # spent 14.5ms making 1 call to XSLoader::load, recursion: max depth 1, sum of overlapping time 14.5ms
111
112	1	43µs			1;
113					__END__

					# spent 39µs within attributes::CORE:qr which was called 2 times, avg 20µs/call: # once (30µs+0s) by DynaLoader::BEGIN@92 at line 22 # once (9µs+0s) by DynaLoader::BEGIN@92 at line 23 sub attributes::CORE:qr; # opcode
					# spent 6µs within attributes::_modify_attrs which was called: # once (6µs+0s) by attributes::_modify_attrs_and_deprecate at line 33 sub attributes::_modify_attrs; # xsub
					# spent 6µs within attributes::reftype which was called: # once (6µs+0s) by attributes::import at line 57 sub attributes::reftype; # xsub