Profile of strictures.pm

Filename	/home/hejohns/perl5/lib/perl5/strictures.pm
Statements	Executed 113 statements in 868µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
3	1	1	32µs	1.26ms	strictures::::_enable_2strictures::_enable_2
3	3	3	26µs	38µs	strictures::::VERSIONstrictures::VERSION
3	1	1	18µs	1.28ms	strictures::::_enablestrictures::_enable
3	3	3	16µs	1.30ms	strictures::::importstrictures::import
3	1	1	11µs	15µs	strictures::::_want_extrastrictures::_want_extra
1	1	1	7µs	8µs	strictures::::BEGIN@3strictures::BEGIN@3
1	1	1	5µs	5µs	strictures::::BEGIN@6strictures::BEGIN@6
1	1	1	3µs	11µs	strictures::::BEGIN@97strictures::BEGIN@97
3	1	1	2µs	2µs	strictures::::_want_extra_envstrictures::_want_extra_env
1	1	1	2µs	19µs	strictures::::BEGIN@4strictures::BEGIN@4
3	1	1	2µs	2µs	strictures::::CORE:matchstrictures::CORE:match (opcode)
0	0	0	0s	0s	strictures::::_enable_1strictures::_enable_1
0	0	0	0s	0s	strictures::::_load_extrasstrictures::_load_extras

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

Line	State ments	Time on line	Calls	Time in subs	Code
1					package strictures;
2
3	2	18µs	2	10µs	# spent 8µs (7+1) within strictures::BEGIN@3 which was called: # once (7µs+1µs) by main::BEGIN@5 at line 3 use strict; # spent 8µs making 1 call to strictures::BEGIN@3 # spent 1µs making 1 call to strict::import
4	2	55µs	2	35µs	# spent 19µs (2+16) within strictures::BEGIN@4 which was called: # once (2µs+16µs) by main::BEGIN@5 at line 4 use warnings FATAL => 'all'; # spent 19µs making 1 call to strictures::BEGIN@4 # spent 16µs making 1 call to warnings::import
5
6					# spent 5µs within strictures::BEGIN@6 which was called: # once (5µs+0s) by main::BEGIN@5 at line 11 BEGIN {
7	1	2µs			*_PERL_LT_5_8_4 = ("$]" < 5.008004) ? sub(){1} : sub(){0};
8					# goto &UNIVERSAL::VERSION usually works on 5.8, but fails on some ARM
9					# machines. Seems to always work on 5.10 though.
10	1	2µs			*_CAN_GOTO_VERSION = ("$]" >= 5.010000) ? sub(){1} : sub(){0};
11	1	80µs	1	5µs	} # spent 5µs making 1 call to strictures::BEGIN@6
12
13	1	200ns			our $VERSION = '2.000006';
14	1	900ns			$VERSION =~ tr/_//d;
15
16	1	10µs			our @WARNING_CATEGORIES = grep { exists $warnings::Offsets{$_} } qw(
17					closure
18					chmod
19					deprecated
20					exiting
21					experimental
22					experimental::alpha_assertions
23					experimental::autoderef
24					experimental::bitwise
25					experimental::const_attr
26					experimental::declared_refs
27					experimental::lexical_subs
28					experimental::lexical_topic
29					experimental::postderef
30					experimental::private_use
31					experimental::re_strict
32					experimental::refaliasing
33					experimental::regex_sets
34					experimental::script_run
35					experimental::signatures
36					experimental::smartmatch
37					experimental::win32_perlio
38					glob
39					imprecision
40					io
41					closed
42					exec
43					layer
44					newline
45					pipe
46					syscalls
47					unopened
48					locale
49					misc
50					missing
51					numeric
52					once
53					overflow
54					pack
55					portable
56					recursion
57					redefine
58					redundant
59					regexp
60					severe
61					debugging
62					inplace
63					internal
64					malloc
65					shadow
66					signal
67					substr
68					syntax
69					ambiguous
70					bareword
71					digit
72					illegalproto
73					parenthesis
74					precedence
75					printf
76					prototype
77					qw
78					reserved
79					semicolon
80					taint
81					threads
82					uninitialized
83					umask
84					unpack
85					untie
86					utf8
87					non_unicode
88					nonchar
89					surrogate
90					void
91					void_unusual
92					y2k
93					);
94
95					# spent 38µs (26+12) within strictures::VERSION which was called 3 times, avg 12µs/call: # once (10µs+6µs) by main::BEGIN@5 at line 5 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/bin/split.pl # once (9µs+3µs) by Gradescope::Translate::BEGIN@4 at line 4 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/lib/Gradescope/Translate.pm # once (7µs+3µs) by Gradescope::Color::BEGIN@4 at line 4 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/lib/Gradescope/Color.pm sub VERSION {
96					{
97	5	552µs	2	20µs	# spent 11µs (3+8) within strictures::BEGIN@97 which was called: # once (3µs+8µs) by main::BEGIN@5 at line 97 no warnings; # spent 11µs making 1 call to strictures::BEGIN@97 # spent 8µs making 1 call to warnings::unimport
98	3	500ns			local $@;
99	9	26µs	3	12µs	if (defined $_[1] && eval { &UNIVERSAL::VERSION; 1}) { # spent 6µs making 2 calls to version::_VERSION, avg 3µs/call # spent 6µs making 1 call to UNIVERSAL::VERSION
100	3	2µs			$^H \|= 0x20000
101					unless _PERL_LT_5_8_4;
102	3	5µs			$^H{strictures_enable} = int $_[1];
103					}
104					}
105	3	22µs	3	2µs	_CAN_GOTO_VERSION ? goto &UNIVERSAL::VERSION : &UNIVERSAL::VERSION; # spent 900ns making 1 call to UNIVERSAL::VERSION # spent 600ns making 2 calls to version::_VERSION, avg 300ns/call
106					}
107
108					our %extra_load_states;
109
110					our $Smells_Like_VCS;
111
112					# spent 1.30ms (16µs+1.28) within strictures::import which was called 3 times, avg 432µs/call: # once (5µs+434µs) by Gradescope::Translate::BEGIN@4 at line 4 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/lib/Gradescope/Translate.pm # once (6µs+430µs) by main::BEGIN@5 at line 5 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/bin/split.pl # once (5µs+416µs) by Gradescope::Color::BEGIN@4 at line 4 of /home/hejohns/documentsNoSync/22f/490/gradescope-utils/lib/Gradescope/Color.pm sub import {
113	3	900ns			my $class = shift;
114	3	2µs			my %opts = @_ == 1 ? %{$_[0]} : @_;
115	3	5µs			if (!exists $opts{version}) {
116					$opts{version}
117					= exists $^H{strictures_enable} ? delete $^H{strictures_enable}
118					: int $VERSION;
119					}
120	3	3µs			$opts{file} = (caller)[1];
121	3	6µs	3	1.28ms	$class->_enable(\%opts); # spent 1.28ms making 3 calls to strictures::_enable, avg 427µs/call
122					}
123
124					# spent 1.28ms (18µs+1.26) within strictures::_enable which was called 3 times, avg 427µs/call: # 3 times (18µs+1.26ms) by strictures::import at line 121, avg 427µs/call sub _enable {
125	3	1µs			my ($class, $opts) = @_;
126	3	900ns			my $version = $opts->{version};
127	3	500ns			$version = 'undef'
128					if !defined $version;
129	3	1µs			my $method = "_enable_$version";
130	3	11µs	3	2µs	if (!$class->can($method)) { # spent 2µs making 3 calls to UNIVERSAL::can, avg 833ns/call
131					require Carp;
132					Carp::croak("Major version specified as $version - not supported!");
133					}
134	3	6µs	3	1.26ms	$class->$method($opts); # spent 1.26ms making 3 calls to strictures::_enable_2, avg 420µs/call
135					}
136
137					sub _enable_1 {
138					my ($class, $opts) = @_;
139					strict->import;
140					warnings->import(FATAL => 'all');
141
142					if (_want_extra($opts->{file})) {
143					_load_extras(qw(indirect multidimensional bareword::filehandles));
144					indirect->unimport(':fatal')
145					if $extra_load_states{indirect};
146					multidimensional->unimport
147					if $extra_load_states{multidimensional};
148					bareword::filehandles->unimport
149					if $extra_load_states{'bareword::filehandles'};
150					}
151					}
152
153	1	1µs			our @V2_NONFATAL = grep { exists $warnings::Offsets{$_} } (
154					'exec', # not safe to catch
155					'recursion', # will be caught by other mechanisms
156					'internal', # not safe to catch
157					'malloc', # not safe to catch
158					'newline', # stat on nonexistent file with a newline in it
159					'experimental', # no reason for these to be fatal
160					'deprecated', # unfortunately can't make these fatal
161					'portable', # everything worked fine here, just may not elsewhere
162					);
163	1	300ns			our @V2_DISABLE = grep { exists $warnings::Offsets{$_} } (
164					'once' # triggers inconsistently, can't be fatalized
165					);
166
167					# spent 1.26ms (32µs+1.23) within strictures::_enable_2 which was called 3 times, avg 420µs/call: # 3 times (32µs+1.23ms) by strictures::_enable at line 134, avg 420µs/call sub _enable_2 {
168	3	800ns			my ($class, $opts) = @_;
169	3	8µs	3	3µs	strict->import; # spent 3µs making 3 calls to strict::import, avg 1µs/call
170	3	2µs	3	44µs	warnings->import; # spent 44µs making 3 calls to warnings::import, avg 15µs/call
171	3	3µs	3	1.02ms	warnings->import(FATAL => @WARNING_CATEGORIES); # spent 1.02ms making 3 calls to warnings::import, avg 340µs/call
172	3	3µs	3	25µs	warnings->unimport(FATAL => @V2_NONFATAL); # spent 25µs making 3 calls to warnings::unimport, avg 8µs/call
173	3	2µs	3	109µs	warnings->import(@V2_NONFATAL); # spent 109µs making 3 calls to warnings::import, avg 36µs/call
174	3	2µs	3	13µs	warnings->unimport(@V2_DISABLE); # spent 13µs making 3 calls to warnings::unimport, avg 4µs/call
175
176	3	7µs	3	15µs	if (_want_extra($opts->{file})) { # spent 15µs making 3 calls to strictures::_want_extra, avg 5µs/call
177					_load_extras(qw(indirect multidimensional bareword::filehandles));
178					indirect->unimport(':fatal')
179					if $extra_load_states{indirect};
180					multidimensional->unimport
181					if $extra_load_states{multidimensional};
182					bareword::filehandles->unimport
183					if $extra_load_states{'bareword::filehandles'};
184					}
185					}
186
187					# spent 2µs within strictures::_want_extra_env which was called 3 times, avg 833ns/call: # 3 times (2µs+0s) by strictures::_want_extra at line 200, avg 833ns/call sub _want_extra_env {
188	3	700ns			if (exists $ENV{PERL_STRICTURES_EXTRA}) {
189					if (_PERL_LT_5_8_4 and $ENV{PERL_STRICTURES_EXTRA}) {
190					die 'PERL_STRICTURES_EXTRA checks are not available on perls older'
191					. "than 5.8.4: please unset \$ENV{PERL_STRICTURES_EXTRA}\n";
192					}
193					return $ENV{PERL_STRICTURES_EXTRA} ? 1 : 0;
194					}
195	3	4µs			return undef;
196					}
197
198					# spent 15µs (11+4) within strictures::_want_extra which was called 3 times, avg 5µs/call: # 3 times (11µs+4µs) by strictures::_enable_2 at line 176, avg 5µs/call sub _want_extra {
199	3	500ns			my $file = shift;
200	3	2µs	3	2µs	my $want_env = _want_extra_env(); # spent 2µs making 3 calls to strictures::_want_extra_env, avg 833ns/call
201	3	800ns			return $want_env
202					if defined $want_env;
203					return (
204	3	8µs	3	2µs	!_PERL_LT_5_8_4 # spent 2µs making 3 calls to strictures::CORE:match, avg 533ns/call
205					and $file =~ /^(?:t\|xt\|lib\|blib)[\\\/]/
206					and defined $Smells_Like_VCS ? $Smells_Like_VCS
207					: ( $Smells_Like_VCS = !!(
208					-e '.git' \|\| -e '.svn' \|\| -e '.hg' \|\| -e '.bzr'
209					\|\| (-e '../../dist.ini'
210					&& (-e '../../.git' \|\| -e '../../.svn' \|\| -e '../../.hg' \|\| -e '../../.bzr' ))
211					))
212					);
213					}
214
215					sub _load_extras {
216					my @extras = @_;
217					my @failed;
218					foreach my $mod (@extras) {
219					next
220					if exists $extra_load_states{$mod};
221
222					$extra_load_states{$mod} = eval "require $mod; 1;" or do {
223					push @failed, $mod;
224
225					#work around 5.8 require bug
226					(my $file = $mod) =~ s\|::\|/\|g;
227					delete $INC{"${file}.pm"};
228					};
229					}
230
231					if (@failed) {
232					my $failed = join ' ', @failed;
233					my $extras = join ' ', @extras;
234					print STDERR <<EOE;
235					strictures.pm extra testing active but couldn't load all modules. Missing were:
236
237					$failed
238
239					Extra testing is auto-enabled in checkouts only, so if you're the author
240					of a strictures-using module you need to run:
241
242					cpan $extras
243
244					but these modules are not required by your users.
245					EOE
246					}
247					}
248
249	1	8µs			1;
250
251					__END__

					# spent 2µs within strictures::CORE:match which was called 3 times, avg 533ns/call: # 3 times (2µs+0s) by strictures::_want_extra at line 204, avg 533ns/call sub strictures::CORE:match; # opcode