Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Eval/TypeTiny.pm |
Statements | Executed 1357 statements in 8.54ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
46 | 2 | 2 | 6.84ms | 13.3ms | eval_closure | Eval::TypeTiny::
46 | 1 | 1 | 5.88ms | 5.91ms | _clean_eval | Eval::TypeTiny::
1 | 1 | 1 | 1.74ms | 2.15ms | import | Eval::TypeTiny::
38 | 1 | 1 | 261µs | 277µs | _make_lexical_assignment | Eval::TypeTiny::
46 | 1 | 1 | 51µs | 51µs | CORE:subst (opcode) | Eval::TypeTiny::
46 | 1 | 1 | 23µs | 23µs | CORE:sort (opcode) | Eval::TypeTiny::
1 | 1 | 1 | 17µs | 31µs | BEGIN@34 | Eval::TypeTiny::
38 | 1 | 1 | 16µs | 16µs | CORE:match (opcode) | Eval::TypeTiny::
1 | 1 | 1 | 15µs | 32µs | BEGIN@3 | Eval::TypeTiny::
1 | 1 | 1 | 11µs | 16µs | BEGIN@45 | Eval::TypeTiny::
1 | 1 | 1 | 6µs | 6µs | BEGIN@5 | Eval::TypeTiny::
0 | 0 | 0 | 0s | 0s | HAS_LEXICAL_VARS | Eval::TypeTiny::
0 | 0 | 0 | 0s | 0s | _manufacture_ties | Eval::TypeTiny::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Eval::TypeTiny; | ||||
2 | |||||
3 | 2 | 78µs | 2 | 48µs | # spent 32µs (15+16) within Eval::TypeTiny::BEGIN@3 which was called:
# once (15µs+16µs) by Type::Library::BEGIN@12 at line 3 # spent 32µs making 1 call to Eval::TypeTiny::BEGIN@3
# spent 16µs making 1 call to strict::import |
4 | |||||
5 | # spent 6µs within Eval::TypeTiny::BEGIN@5 which was called:
# once (6µs+0s) by Type::Library::BEGIN@12 at line 7 | ||||
6 | 1 | 7µs | *HAS_LEXICAL_SUBS = ($] >= 5.018) ? sub(){!!1} : sub(){!!0}; | ||
7 | 1 | 185µs | 1 | 6µs | }; # spent 6µs making 1 call to Eval::TypeTiny::BEGIN@5 |
8 | |||||
9 | { | ||||
10 | 2 | 700ns | my $hlv; | ||
11 | sub HAS_LEXICAL_VARS () { | ||||
12 | $hlv = !! eval { require Devel::LexAlias } unless defined $hlv; | ||||
13 | return $hlv; | ||||
14 | } | ||||
15 | } | ||||
16 | |||||
17 | sub _clean_eval | ||||
18 | # spent 5.91ms (5.88+32µs) within Eval::TypeTiny::_clean_eval which was called 46 times, avg 128µs/call:
# 46 times (5.88ms+32µs) by Eval::TypeTiny::eval_closure at line 82, avg 128µs/call | ||||
19 | 46 | 9µs | local $@; | ||
20 | 46 | 87µs | local $SIG{__DIE__}; | ||
21 | 46 | 5.24ms | my $r = eval $_[0]; # spent 5.58ms executing statements in 20 string evals (merged) # includes 82µs spent executing 20 calls to 2 subs defined therein. # spent 227µs executing statements in 18 string evals (merged) # includes 85µs spent executing 18 calls to 2 subs defined therein. # spent 117µs executing statements in string eval # includes 24µs spent executing 2 calls to 3 subs defined therein. # spent 33µs executing statements in string eval # includes 23µs spent executing 4 calls to 2 subs defined therein. # spent 20µs executing statements in string eval # includes 8µs spent executing 4 calls to 2 subs defined therein. # spent 12µs executing statements in string eval # includes 4µs spent executing 1 call to 2 subs defined therein. # spent 12µs executing statements in string eval # includes 4µs spent executing 1 call to 2 subs defined therein. # spent 12µs executing statements in string eval # includes 4µs spent executing 1 call to 2 subs defined therein. # spent 11µs executing statements in string eval # includes 4µs spent executing 1 call to 2 subs defined therein. # spent 11µs executing statements in string eval # includes 4µs spent executing 1 call to 2 subs defined therein. | ||
22 | 46 | 10µs | my $e = $@; | ||
23 | 46 | 315µs | return ($r, $e); | ||
24 | } | ||||
25 | |||||
26 | 1 | 900ns | our $AUTHORITY = 'cpan:TOBYINK'; | ||
27 | 1 | 200ns | our $VERSION = '0.038'; | ||
28 | 1 | 900ns | our @EXPORT = qw( eval_closure ); | ||
29 | 1 | 700ns | our @EXPORT_OK = qw( HAS_LEXICAL_SUBS HAS_LEXICAL_VARS ); | ||
30 | |||||
31 | sub import | ||||
32 | # spent 2.15ms (1.74+409µs) within Eval::TypeTiny::import which was called:
# once (1.74ms+409µs) by Type::Library::BEGIN@12 at line 12 of Type/Library.pm | ||||
33 | # do the shuffle! | ||||
34 | 2 | 132µs | 2 | 45µs | # spent 31µs (17+14) within Eval::TypeTiny::BEGIN@34 which was called:
# once (17µs+14µs) by Type::Library::BEGIN@12 at line 34 # spent 31µs making 1 call to Eval::TypeTiny::BEGIN@34
# spent 14µs making 1 call to warnings::unimport |
35 | 1 | 7µs | our @ISA = qw( Exporter::Tiny ); | ||
36 | 1 | 85µs | require Exporter::Tiny; | ||
37 | 1 | 800ns | my $next = \&Exporter::Tiny::import; | ||
38 | 1 | 2µs | *import = $next; | ||
39 | 1 | 600ns | my $class = shift; | ||
40 | 1 | 700ns | my $opts = { ref($_[0]) ? %{+shift} : () }; | ||
41 | 1 | 2µs | $opts->{into} ||= scalar(caller); | ||
42 | 1 | 17µs | 1 | 200µs | return $class->$next($opts, @_); # spent 200µs making 1 call to Exporter::Tiny::import |
43 | } | ||||
44 | |||||
45 | 2 | 805µs | 2 | 21µs | # spent 16µs (11+5) within Eval::TypeTiny::BEGIN@45 which was called:
# once (11µs+5µs) by Type::Library::BEGIN@12 at line 45 # spent 16µs making 1 call to Eval::TypeTiny::BEGIN@45
# spent 5µs making 1 call to warnings::import |
46 | |||||
47 | sub eval_closure | ||||
48 | # spent 13.3ms (6.84+6.46) within Eval::TypeTiny::eval_closure which was called 46 times, avg 289µs/call:
# 38 times (6.61ms+5.32ms) by Type::Library::_mksub at line 100 of Type/Library.pm, avg 314µs/call
# 8 times (232µs+1.14ms) by Type::Tiny::_build_compiled_check at line 326 of Type/Tiny.pm, avg 171µs/call | ||||
49 | 46 | 88µs | my (%args) = @_; | ||
50 | 46 | 36µs | my $src = ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source}; | ||
51 | |||||
52 | 46 | 33µs | $args{alias} = 0 unless defined $args{alias}; | ||
53 | 46 | 20µs | $args{line} = 1 unless defined $args{line}; | ||
54 | 46 | 168µs | 46 | 51µs | $args{description} =~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined $args{description}; # spent 51µs making 46 calls to Eval::TypeTiny::CORE:subst, avg 1µs/call |
55 | 46 | 44µs | $src = qq{#line $args{line} "$args{description}"\n$src} if defined $args{description} && !($^P & 0x10); | ||
56 | 46 | 14µs | $args{environment} ||= {}; | ||
57 | |||||
58 | # for my $k (sort keys %{$args{environment}}) | ||||
59 | # { | ||||
60 | # next if $k =~ /^\$/ && ref($args{environment}{$k}) =~ /^(SCALAR|REF)$/; | ||||
61 | # next if $k =~ /^\@/ && ref($args{environment}{$k}) eq q(ARRAY); | ||||
62 | # next if $k =~ /^\%/ && ref($args{environment}{$k}) eq q(HASH); | ||||
63 | # | ||||
64 | # require Error::TypeTiny; | ||||
65 | # Error::TypeTiny::croak("Expected a variable name and ref; got %s => %s", $k, $args{environment}{$k}); | ||||
66 | # } | ||||
67 | |||||
68 | 46 | 10µs | my $sandpkg = 'Eval::TypeTiny::Sandbox'; | ||
69 | 46 | 22µs | my $alias = exists($args{alias}) ? $args{alias} : 0; | ||
70 | 46 | 209µs | 46 | 23µs | my @keys = sort keys %{$args{environment}}; # spent 23µs making 46 calls to Eval::TypeTiny::CORE:sort, avg 493ns/call |
71 | 46 | 5µs | my $i = 0; | ||
72 | 46 | 154µs | 38 | 277µs | my $source = join "\n" => ( # spent 277µs making 38 calls to Eval::TypeTiny::_make_lexical_assignment, avg 7µs/call |
73 | "package $sandpkg;", | ||||
74 | "sub {", | ||||
75 | map(_make_lexical_assignment($_, $i++, $alias), @keys), | ||||
76 | $src, | ||||
77 | "}", | ||||
78 | ); | ||||
79 | |||||
80 | 46 | 5µs | _manufacture_ties() if $alias && !HAS_LEXICAL_VARS; | ||
81 | |||||
82 | 46 | 89µs | 46 | 5.91ms | my ($compiler, $e) = _clean_eval($source); # spent 5.91ms making 46 calls to Eval::TypeTiny::_clean_eval, avg 128µs/call |
83 | 46 | 5µs | if ($e) | ||
84 | { | ||||
85 | chomp $e; | ||||
86 | require Error::TypeTiny::Compilation; | ||||
87 | "Error::TypeTiny::Compilation"->throw( | ||||
88 | code => (ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source}), | ||||
89 | errstr => $e, | ||||
90 | environment => $args{environment}, | ||||
91 | ); | ||||
92 | } | ||||
93 | |||||
94 | 46 | 138µs | 46 | 199µs | my $code = $compiler->(@{$args{environment}}{@keys}); # spent 85µs making 18 calls to Eval::TypeTiny::Sandbox::__ANON__[(eval 306)[Eval/TypeTiny.pm:21]:11], avg 5µs/call
# spent 82µs making 20 calls to Eval::TypeTiny::Sandbox::__ANON__[(eval 238)[Eval/TypeTiny.pm:21]:5], avg 4µs/call
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 395)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 275)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 378)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 389)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 420)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 302)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 419)[Eval/TypeTiny.pm:21]:4]
# spent 4µs making 1 call to Eval::TypeTiny::Sandbox::__ANON__[(eval 281)[Eval/TypeTiny.pm:21]:9] |
95 | 46 | 10µs | undef($compiler); | ||
96 | |||||
97 | 46 | 5µs | if ($alias && HAS_LEXICAL_VARS) { | ||
98 | Devel::LexAlias::lexalias($code, $_, $args{environment}{$_}) for grep !/^\&/, @keys; | ||||
99 | } | ||||
100 | |||||
101 | 46 | 201µs | return $code; | ||
102 | } | ||||
103 | |||||
104 | 1 | 0s | my $tmp; | ||
105 | sub _make_lexical_assignment | ||||
106 | # spent 277µs (261+16) within Eval::TypeTiny::_make_lexical_assignment which was called 38 times, avg 7µs/call:
# 38 times (261µs+16µs) by Eval::TypeTiny::eval_closure at line 72, avg 7µs/call | ||||
107 | 38 | 13µs | my ($key, $index, $alias) = @_; | ||
108 | 38 | 28µs | my $name = substr($key, 1); | ||
109 | |||||
110 | 38 | 90µs | 38 | 16µs | if (HAS_LEXICAL_SUBS and $key =~ /^\&/) { # spent 16µs making 38 calls to Eval::TypeTiny::CORE:match, avg 421ns/call |
111 | $tmp++; | ||||
112 | my $tmpname = '$__LEXICAL_SUB__'.$tmp; | ||||
113 | return | ||||
114 | "no warnings 'experimental::lexical_subs';". | ||||
115 | "use feature 'lexical_subs';". | ||||
116 | "my $tmpname = \$_[$index];". | ||||
117 | "my sub $name { goto $tmpname };"; | ||||
118 | } | ||||
119 | |||||
120 | 38 | 11µs | if (!$alias) { | ||
121 | 38 | 16µs | my $sigil = substr($key, 0, 1); | ||
122 | 38 | 145µs | return "my $key = $sigil\{ \$_[$index] };"; | ||
123 | } | ||||
124 | elsif (HAS_LEXICAL_VARS) { | ||||
125 | return "my $key;"; | ||||
126 | } | ||||
127 | else { | ||||
128 | my $tieclass = { | ||||
129 | '@' => 'Eval::TypeTiny::_TieArray', | ||||
130 | '%' => 'Eval::TypeTiny::_TieHash', | ||||
131 | '$' => 'Eval::TypeTiny::_TieScalar', | ||||
132 | }->{ substr($key, 0, 1) }; | ||||
133 | |||||
134 | return sprintf( | ||||
135 | 'tie(my(%s), "%s", $_[%d]);', | ||||
136 | $key, | ||||
137 | $tieclass, | ||||
138 | $index, | ||||
139 | ); | ||||
140 | } | ||||
141 | } | ||||
142 | |||||
143 | 2 | 100ns | { my $tie; sub _manufacture_ties { $tie ||= eval <<'FALLBACK'; } } | ||
144 | no warnings qw(void once uninitialized numeric); | ||||
145 | |||||
146 | { | ||||
147 | package # | ||||
148 | Eval::TypeTiny::_TieArray; | ||||
149 | require Tie::Array; | ||||
150 | our @ISA = qw( Tie::StdArray ); | ||||
151 | sub TIEARRAY { | ||||
152 | my $class = shift; | ||||
153 | bless $_[0] => $class; | ||||
154 | } | ||||
155 | sub AUTOLOAD { | ||||
156 | my $self = shift; | ||||
157 | my ($method) = (our $AUTOLOAD =~ /(\w+)$/); | ||||
158 | defined tied(@$self) and return tied(@$self)->$method(@_); | ||||
159 | require Carp; | ||||
160 | Carp::croak(qq[Can't call method "$method" on an undefined value]); | ||||
161 | } | ||||
162 | sub can { | ||||
163 | my $self = shift; | ||||
164 | my $code = $self->SUPER::can(@_) | ||||
165 | || (defined tied(@$self) and tied(@$self)->can(@_)); | ||||
166 | return $code; | ||||
167 | } | ||||
168 | use overload | ||||
169 | q[bool] => sub { !! tied @{$_[0]} }, | ||||
170 | q[""] => sub { '' . tied @{$_[0]} }, | ||||
171 | q[0+] => sub { 0 + tied @{$_[0]} }, | ||||
172 | fallback => 1, | ||||
173 | ; | ||||
174 | } | ||||
175 | { | ||||
176 | package # | ||||
177 | Eval::TypeTiny::_TieHash; | ||||
178 | require Tie::Hash; | ||||
179 | our @ISA = qw( Tie::StdHash ); | ||||
180 | sub TIEHASH { | ||||
181 | my $class = shift; | ||||
182 | bless $_[0] => $class; | ||||
183 | } | ||||
184 | sub AUTOLOAD { | ||||
185 | my $self = shift; | ||||
186 | my ($method) = (our $AUTOLOAD =~ /(\w+)$/); | ||||
187 | defined tied(%$self) and return tied(%$self)->$method(@_); | ||||
188 | require Carp; | ||||
189 | Carp::croak(qq[Can't call method "$method" on an undefined value]); | ||||
190 | } | ||||
191 | sub can { | ||||
192 | my $self = shift; | ||||
193 | my $code = $self->SUPER::can(@_) | ||||
194 | || (defined tied(%$self) and tied(%$self)->can(@_)); | ||||
195 | return $code; | ||||
196 | } | ||||
197 | use overload | ||||
198 | q[bool] => sub { !! tied %{$_[0]} }, | ||||
199 | q[""] => sub { '' . tied %{$_[0]} }, | ||||
200 | q[0+] => sub { 0 + tied %{$_[0]} }, | ||||
201 | fallback => 1, | ||||
202 | ; | ||||
203 | } | ||||
204 | { | ||||
205 | package # | ||||
206 | Eval::TypeTiny::_TieScalar; | ||||
207 | require Tie::Scalar; | ||||
208 | our @ISA = qw( Tie::StdScalar ); | ||||
209 | sub TIESCALAR { | ||||
210 | my $class = shift; | ||||
211 | bless $_[0] => $class; | ||||
212 | } | ||||
213 | sub AUTOLOAD { | ||||
214 | my $self = shift; | ||||
215 | my ($method) = (our $AUTOLOAD =~ /(\w+)$/); | ||||
216 | defined tied($$self) and return tied($$self)->$method(@_); | ||||
217 | require Carp; | ||||
218 | Carp::croak(qq[Can't call method "$method" on an undefined value]); | ||||
219 | } | ||||
220 | sub can { | ||||
221 | my $self = shift; | ||||
222 | my $code = $self->SUPER::can(@_) | ||||
223 | || (defined tied($$self) and tied($$self)->can(@_)); | ||||
224 | return $code; | ||||
225 | } | ||||
226 | use overload | ||||
227 | q[bool] => sub { !! tied ${$_[0]} }, | ||||
228 | q[""] => sub { '' . tied ${$_[0]} }, | ||||
229 | q[0+] => sub { 0 + tied ${$_[0]} }, | ||||
230 | fallback => 1, | ||||
231 | ; | ||||
232 | } | ||||
233 | |||||
234 | 1; | ||||
235 | FALLBACK | ||||
236 | |||||
237 | 1 | 6µs | 1; | ||
238 | |||||
239 | __END__ | ||||
# spent 16µs within Eval::TypeTiny::CORE:match which was called 38 times, avg 421ns/call:
# 38 times (16µs+0s) by Eval::TypeTiny::_make_lexical_assignment at line 110, avg 421ns/call | |||||
# spent 23µs within Eval::TypeTiny::CORE:sort which was called 46 times, avg 493ns/call:
# 46 times (23µs+0s) by Eval::TypeTiny::eval_closure at line 70, avg 493ns/call | |||||
# spent 51µs within Eval::TypeTiny::CORE:subst which was called 46 times, avg 1µs/call:
# 46 times (51µs+0s) by Eval::TypeTiny::eval_closure at line 54, avg 1µs/call |