Filename | /usr/lib/perl5/Function/Parameters.pm |
Statements | Executed 319 statements in 4.66ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 4.03ms | 4.82ms | BEGIN@7 | Function::Parameters::
1 | 1 | 1 | 3.28ms | 3.32ms | BEGIN@5 | Function::Parameters::
4 | 4 | 4 | 226µs | 406µs | import | Function::Parameters::
12 | 1 | 1 | 73µs | 73µs | CORE:regcomp (opcode) | Function::Parameters::
12 | 2 | 1 | 55µs | 144µs | _assert_valid_identifier | Function::Parameters::
24 | 3 | 1 | 42µs | 42µs | CORE:match (opcode) | Function::Parameters::
1 | 1 | 1 | 21µs | 21µs | BEGIN@3 | Function::Parameters::
1 | 1 | 1 | 12µs | 62µs | BEGIN@3.2 | Function::Parameters::
4 | 1 | 1 | 11µs | 27µs | _assert_valid_attributes | Function::Parameters::
1 | 1 | 1 | 6µs | 124µs | BEGIN@10 | Function::Parameters::
1 | 1 | 1 | 4µs | 4µs | BEGIN@9 | Function::Parameters::
0 | 0 | 0 | 0s | 0s | unimport | Function::Parameters::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Function::Parameters; | ||||
2 | |||||
3 | 4 | 114µs | 3 | 134µs | use v5.14.0; # spent 62µs making 1 call to Function::Parameters::BEGIN@3.2
# spent 51µs making 1 call to feature::import
# spent 21µs making 1 call to Function::Parameters::BEGIN@3 |
4 | |||||
5 | 2 | 3.11ms | 2 | 3.34ms | # spent 3.32ms (3.28+44µs) within Function::Parameters::BEGIN@5 which was called:
# once (3.28ms+44µs) by main::BEGIN@8 at line 5 # spent 3.32ms making 1 call to Function::Parameters::BEGIN@5
# spent 12µs making 1 call to warnings::import |
6 | |||||
7 | 2 | 169µs | 2 | 4.96ms | # spent 4.82ms (4.03+789µs) within Function::Parameters::BEGIN@7 which was called:
# once (4.03ms+789µs) by main::BEGIN@8 at line 7 # spent 4.82ms making 1 call to Function::Parameters::BEGIN@7
# spent 146µs making 1 call to Exporter::import |
8 | |||||
9 | 2 | 29µs | 1 | 4µs | # spent 4µs within Function::Parameters::BEGIN@9 which was called:
# once (4µs+0s) by main::BEGIN@8 at line 9 # spent 4µs making 1 call to Function::Parameters::BEGIN@9 |
10 | # spent 124µs (6+118) within Function::Parameters::BEGIN@10 which was called:
# once (6µs+118µs) by main::BEGIN@8 at line 13 | ||||
11 | 1 | 300ns | our $VERSION = '1.0004'; | ||
12 | 1 | 124µs | 1 | 118µs | XSLoader::load; # spent 118µs making 1 call to XSLoader::load |
13 | 1 | 679µs | 1 | 124µs | } # spent 124µs making 1 call to Function::Parameters::BEGIN@10 |
14 | |||||
15 | sub _assert_valid_identifier { | ||||
16 | 12 | 4µs | my ($name, $with_dollar) = @_; | ||
17 | 12 | 3µs | my $bonus = $with_dollar ? '\$' : ''; | ||
18 | 12 | 145µs | 24 | 89µs | $name =~ /^${bonus}[^\W\d]\w*\z/ # spent 73µs making 12 calls to Function::Parameters::CORE:regcomp, avg 6µs/call
# spent 16µs making 12 calls to Function::Parameters::CORE:match, avg 1µs/call |
19 | or confess qq{"$name" doesn't look like a valid identifier}; | ||||
20 | } | ||||
21 | |||||
22 | # spent 27µs (11+16) within Function::Parameters::_assert_valid_attributes which was called 4 times, avg 7µs/call:
# 4 times (11µs+16µs) by Function::Parameters::import at line 109, avg 7µs/call | ||||
23 | 4 | 2µs | my ($attrs) = @_; | ||
24 | 4 | 27µs | 4 | 16µs | $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/ # spent 16µs making 4 calls to Function::Parameters::CORE:match, avg 4µs/call |
25 | or confess qq{"$attrs" doesn't look like valid attributes}; | ||||
26 | } | ||||
27 | |||||
28 | 1 | 800ns | my @bare_arms = qw(function method); | ||
29 | 1 | 4µs | my %type_map = ( | ||
30 | function => { | ||||
31 | name => 'optional', | ||||
32 | default_arguments => 1, | ||||
33 | check_argument_count => 0, | ||||
34 | named_parameters => 1, | ||||
35 | }, | ||||
36 | method => { | ||||
37 | name => 'optional', | ||||
38 | default_arguments => 1, | ||||
39 | check_argument_count => 0, | ||||
40 | named_parameters => 1, | ||||
41 | attrs => ':method', | ||||
42 | shift => '$self', | ||||
43 | invocant => 1, | ||||
44 | }, | ||||
45 | classmethod => { | ||||
46 | name => 'optional', | ||||
47 | default_arguments => 1, | ||||
48 | check_argument_count => 0, | ||||
49 | named_parameters => 1, | ||||
50 | attributes => ':method', | ||||
51 | shift => '$class', | ||||
52 | invocant => 1, | ||||
53 | }, | ||||
54 | ); | ||||
55 | 1 | 4µs | for my $k (keys %type_map) { | ||
56 | $type_map{$k . '_strict'} = { | ||||
57 | 3 | 8µs | %{$type_map{$k}}, | ||
58 | check_argument_count => 1, | ||||
59 | }; | ||||
60 | } | ||||
61 | |||||
62 | # spent 406µs (226+181) within Function::Parameters::import which was called 4 times, avg 102µs/call:
# once (66µs+53µs) by main::BEGIN@14 at line 14 of NewIncNPlyPicker.pm
# once (59µs+51µs) by main::BEGIN@8 at line 8 of testnewboardincnply
# once (53µs+40µs) by NewBoard::BEGIN@18 at line 18 of NewBoard.pm
# once (47µs+38µs) by main::BEGIN@6 at line 6 of NewSolveGame.pm | ||||
63 | 4 | 1µs | my $class = shift; | ||
64 | |||||
65 | 4 | 7µs | if (!@_) { | ||
66 | @_ = { | ||||
67 | fun => 'function', | ||||
68 | method => 'method', | ||||
69 | }; | ||||
70 | } | ||||
71 | 4 | 3µs | if (@_ == 1 && $_[0] eq ':strict') { | ||
72 | @_ = { | ||||
73 | fun => 'function_strict', | ||||
74 | method => 'method_strict', | ||||
75 | }; | ||||
76 | } | ||||
77 | 4 | 19µs | if (@_ == 1 && ref($_[0]) eq 'HASH') { | ||
78 | @_ = map [$_, $_[0]{$_}], keys %{$_[0]}; | ||||
79 | } | ||||
80 | |||||
81 | 4 | 600ns | my %spec; | ||
82 | |||||
83 | 4 | 800ns | my $bare = 0; | ||
84 | 4 | 3µs | for my $proto (@_) { | ||
85 | 8 | 3µs | my $item = ref $proto | ||
86 | ? $proto | ||||
87 | : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})] | ||||
88 | ; | ||||
89 | 8 | 4µs | my ($name, $proto_type) = @$item; | ||
90 | 8 | 7µs | 8 | 88µs | _assert_valid_identifier $name; # spent 88µs making 8 calls to Function::Parameters::_assert_valid_identifier, avg 11µs/call |
91 | |||||
92 | 8 | 5µs | unless (ref $proto_type) { | ||
93 | # use '||' instead of 'or' to preserve $proto_type in the error message | ||||
94 | $proto_type = $type_map{$proto_type} | ||||
95 | || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; | ||||
96 | } | ||||
97 | |||||
98 | 8 | 16µs | my %type = %$proto_type; | ||
99 | 8 | 700ns | my %clean; | ||
100 | |||||
101 | 8 | 7µs | $clean{name} = delete $type{name} || 'optional'; | ||
102 | 8 | 20µs | 8 | 10µs | $clean{name} =~ /^(?:optional|required|prohibited)\z/ # spent 10µs making 8 calls to Function::Parameters::CORE:match, avg 1µs/call |
103 | or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; | ||||
104 | |||||
105 | 8 | 5µs | $clean{shift} = delete $type{shift} || ''; | ||
106 | 8 | 5µs | 4 | 55µs | _assert_valid_identifier $clean{shift}, 1 if $clean{shift}; # spent 55µs making 4 calls to Function::Parameters::_assert_valid_identifier, avg 14µs/call |
107 | |||||
108 | 8 | 12µs | $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs); | ||
109 | 8 | 5µs | 4 | 27µs | _assert_valid_attributes $clean{attrs} if $clean{attrs}; # spent 27µs making 4 calls to Function::Parameters::_assert_valid_attributes, avg 7µs/call |
110 | |||||
111 | 8 | 7µs | $clean{default_arguments} = | ||
112 | exists $type{default_arguments} | ||||
113 | ? !!delete $type{default_arguments} | ||||
114 | : 1 | ||||
115 | ; | ||||
116 | 8 | 4µs | $clean{check_argument_count} = !!delete $type{check_argument_count}; | ||
117 | 8 | 3µs | $clean{invocant} = !!delete $type{invocant}; | ||
118 | 8 | 11µs | $clean{named_parameters} = !!delete $type{named_parameters}; | ||
119 | |||||
120 | 8 | 1µs | %type and confess "Invalid keyword property: @{[keys %type]}"; | ||
121 | |||||
122 | 8 | 11µs | $spec{$name} = \%clean; | ||
123 | } | ||||
124 | |||||
125 | 4 | 19µs | for my $kw (keys %spec) { | ||
126 | 8 | 2µs | my $type = $spec{$kw}; | ||
127 | |||||
128 | 8 | 4µs | my $flags = | ||
129 | $type->{name} eq 'prohibited' ? FLAG_ANON_OK : | ||||
130 | $type->{name} eq 'required' ? FLAG_NAME_OK : | ||||
131 | FLAG_ANON_OK | FLAG_NAME_OK | ||||
132 | ; | ||||
133 | 8 | 2µs | $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments}; | ||
134 | 8 | 1µs | $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count}; | ||
135 | 8 | 1µs | $flags |= FLAG_INVOCANT if $type->{invocant}; | ||
136 | 8 | 1µs | $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters}; | ||
137 | 8 | 12µs | $^H{HINTK_FLAGS_ . $kw} = $flags; | ||
138 | 8 | 9µs | $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; | ||
139 | 8 | 7µs | $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; | ||
140 | 8 | 12µs | $^H{+HINTK_KEYWORDS} .= "$kw "; | ||
141 | } | ||||
142 | } | ||||
143 | |||||
144 | sub unimport { | ||||
145 | my $class = shift; | ||||
146 | |||||
147 | if (!@_) { | ||||
148 | delete $^H{+HINTK_KEYWORDS}; | ||||
149 | return; | ||||
150 | } | ||||
151 | |||||
152 | for my $kw (@_) { | ||||
153 | $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g; | ||||
154 | } | ||||
155 | } | ||||
156 | |||||
157 | |||||
158 | 1 | 6µs | 'ok' | ||
159 | |||||
160 | __END__ | ||||
# spent 42µs within Function::Parameters::CORE:match which was called 24 times, avg 2µs/call:
# 12 times (16µs+0s) by Function::Parameters::_assert_valid_identifier at line 18, avg 1µs/call
# 8 times (10µs+0s) by Function::Parameters::import at line 102, avg 1µs/call
# 4 times (16µs+0s) by Function::Parameters::_assert_valid_attributes at line 24, avg 4µs/call | |||||
# spent 73µs within Function::Parameters::CORE:regcomp which was called 12 times, avg 6µs/call:
# 12 times (73µs+0s) by Function::Parameters::_assert_valid_identifier at line 18, avg 6µs/call |