Profile of attributes.pm

Filename	/usr/lib/x86_64-linux-gnu/perl-base/attributes.pm
Statements	Executed 22 statements in 586µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	11µs	19µs	attributes::::importattributes::import
1	1	1	8µs	10µs	attributes::::BEGIN@9attributes::BEGIN@9
1	1	1	4µs	4µs	attributes::_modify_attrs_and_deprecate
1	1	1	1µs	1µs	attributes::::reftypeattributes::reftype (xsub)
1	1	1	500ns	500ns	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	300ns			our $VERSION = 0.34;
4
5	1	600ns			@EXPORT_OK = qw(get reftype);
6	1	200ns			@EXPORT = ();
7	1	1µs			%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]);
8
9	2	450µs	2	12µs	# spent 10µs (8+2) within attributes::BEGIN@9 which was called: # once (8µs+2µs) by DynaLoader::BEGIN@112.2 at line 9 use strict; # 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					# Hash of SV type (CODE, SCALAR, etc.) to regex matching deprecated
22					# attributes for that type.
23	1	100ns			my %deprecated;
24
25	1	900ns			my %msg = (
26					lvalue => 'lvalue attribute applied to already-defined subroutine',
27					-lvalue => 'lvalue attribute removed from already-defined subroutine',
28					const => 'Useless use of attribute "const"',
29					);
30
31					# spent 4µs (4+500ns) within attributes::_modify_attrs_and_deprecate which was called: # once (4µs+500ns) by attributes::import at line 85 sub _modify_attrs_and_deprecate {
32	1	400ns			my $svtype = shift;
33					# After we've removed a deprecated attribute from the XS code, we need to
34					# remove it here, else it ends up in @badattrs. (If we do the deprecation in
35					# XS, we can't control the warning based on our caller's lexical settings,
36					# and the warned line is in this package)
37					grep {
38	1	4µs	1	500ns	$deprecated{$svtype} && /$deprecated{$svtype}/ ? do { # spent 500ns making 1 call to attributes::_modify_attrs
39					require warnings;
40					warnings::warnif('deprecated', "Attribute \"$1\" is deprecated, " .
41					"and will disappear in Perl 5.28");
42					0;
43					} : $svtype eq 'CODE' && exists $msg{$_} ? do {
44					require warnings;
45					warnings::warnif(
46					'misc',
47					$msg{$_}
48					);
49					0;
50					} : 1
51					} _modify_attrs(@_);
52					}
53
54					# spent 19µs (11+8) within attributes::import which was called: # once (11µs+8µs) by DynaLoader::BEGIN@112.2 at line 112 of XSLoader.pm sub import {
55	1	600ns			@_ > 2 && ref $_[2] or do {
56					require Exporter;
57					goto &Exporter::import;
58					};
59	1	700ns			my (undef,$home_stash,$svref,@attrs) = @_;
60
61	1	5µs	1	1µs	my $svtype = uc reftype($svref); # spent 1µs making 1 call to attributes::reftype
62	1	100ns			my $pkgmeth;
63	1	6µs	1	3µs	$pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") # spent 3µs making 1 call to UNIVERSAL::can
64					if defined $home_stash && $home_stash ne '';
65	1	100ns			my @badattrs;
66	1	200ns			if ($pkgmeth) {
67					my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs);
68					@badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
69					if (!@badattrs && @pkgattrs) {
70					require warnings;
71					return unless warnings::enabled('reserved');
72					@pkgattrs = grep { m/\A[[:lower:]]+(?:\z\|\()/ } @pkgattrs;
73					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	1	900ns	1	4µs	@badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); # spent 4µs making 1 call to attributes::_modify_attrs_and_deprecate
86					}
87	1	1µ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	300ns			require XSLoader;
114	1	108µs	1	0s	XSLoader::load(); # spent 102µs making 1 call to XSLoader::load, recursion: max depth 1, sum of overlapping time 102µs
115
116	1	5µs			1;
117					__END__

					# spent 500ns within attributes::_modify_attrs which was called: # once (500ns+0s) by attributes::_modify_attrs_and_deprecate at line 38 sub attributes::_modify_attrs; # xsub
					# spent 1µs within attributes::reftype which was called: # once (1µs+0s) by attributes::import at line 61 sub attributes::reftype; # xsub