Profile of attributes.pm

Filename	/usr/lib/x86_64-linux-gnu/perl/5.20/attributes.pm
Statements	Executed 0 statements in 0s

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	22µs	44µs	attributes::::importattributes::import
1	1	1	19µs	35µs	attributes::::BEGIN@9attributes::BEGIN@9
1	1	1	9µs	11µs	attributes::_modify_attrs_and_deprecate
2	2	1	8µs	8µs	attributes::::CORE:qrattributes::CORE:qr (opcode)
1	1	1	2µs	2µs	attributes::::_modify_attrsattributes::_modify_attrs (xsub)
1	1	1	2µs	2µs	attributes::::reftypeattributes::reftype (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	Calls	Time in subs	Code
1			package attributes;
2
3			our $VERSION = 0.23;
4
5			@EXPORT_OK = qw(get reftype);
6			@EXPORT = ();
7			%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8
9	2	50µs	# spent 35µs (19+15) within attributes::BEGIN@9 which was called: # once (19µs+15µs) by DynaLoader::BEGIN@92 at line 9 use strict; # spent 35µs making 1 call to attributes::BEGIN@9 # spent 15µ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			my %deprecated;
22	1	7µs	$deprecated{CODE} = qr/\A-?(locked)\z/; # spent 7µs making 1 call to attributes::CORE:qr
23	1	1µs	$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} # spent 1µs making 1 call to attributes::CORE:qr
24			= qr/\A-?(unique)\z/;
25
26			# spent 11µs (9+2) within attributes::_modify_attrs_and_deprecate which was called: # once (9µs+2µs) by attributes::import at line 81 sub _modify_attrs_and_deprecate {
27			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	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 44µs (22+23) within attributes::import which was called: # once (22µs+23µs) by DynaLoader::BEGIN@92 at line 92 of XSLoader.pm sub import {
51			@_ > 2 && ref $_[2] or do {
52			require Exporter;
53			goto &Exporter::import;
54			};
55			my (undef,$home_stash,$svref,@attrs) = @_;
56
57	1	2µs	my $svtype = uc reftype($svref); # spent 2µs making 1 call to attributes::reftype
58			my $pkgmeth;
59	1	10µs	$pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 10µs making 1 call to UNIVERSAL::can
60			if defined $home_stash && $home_stash ne '';
61			my @badattrs;
62			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	11µs	@badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 11µs making 1 call to attributes::_modify_attrs_and_deprecate
82			}
83			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			require XSLoader;
110	1	0s	XSLoader::load(); # spent 232µs making 1 call to XSLoader::load, recursion: max depth 1, sum of overlapping time 232µs
111
112			1;
113			__END__

			# spent 8µs within attributes::CORE:qr which was called 2 times, avg 4µs/call: # once (7µs+0s) by DynaLoader::BEGIN@92 at line 22 # once (1µs+0s) by DynaLoader::BEGIN@92 at line 23 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 sub attributes::_modify_attrs; # xsub
			# spent 2µs within attributes::reftype which was called: # once (2µs+0s) by attributes::import at line 57 sub attributes::reftype; # xsub