Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Method/Generate/Accessor.pm |
Statements | Executed 332 statements in 5.64ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 1 | 93µs | 428µs | generate_method | Method::Generate::Accessor::
7 | 1 | 1 | 78µs | 261µs | _generate_populate_set | Method::Generate::Accessor::
9 | 2 | 1 | 70µs | 128µs | _generate_simple_set | Method::Generate::Accessor::
4 | 1 | 1 | 44µs | 77µs | _generate_call_code | Method::Generate::Accessor::
7 | 1 | 1 | 44µs | 305µs | generate_populate_set | Method::Generate::Accessor::
9 | 1 | 1 | 41µs | 49µs | _generate_core_set | Method::Generate::Accessor::
2 | 1 | 1 | 41µs | 155µs | _generate_set | Method::Generate::Accessor::
4 | 1 | 1 | 35µs | 44µs | _generate_die_prefix | Method::Generate::Accessor::
4 | 2 | 1 | 31µs | 152µs | _generate_isa_check | Method::Generate::Accessor::
1 | 1 | 1 | 23µs | 79µs | BEGIN@3 | Method::Generate::Accessor::
2 | 1 | 1 | 19µs | 24µs | _validate_codulatable | Method::Generate::Accessor::
1 | 1 | 1 | 19µs | 51µs | BEGIN@11 | Method::Generate::Accessor::
2 | 1 | 1 | 16µs | 202µs | _generate_getset | Method::Generate::Accessor::
2 | 1 | 1 | 16µs | 30µs | _generate_get | Method::Generate::Accessor::
7 | 1 | 1 | 13µs | 13µs | has_eager_default | Method::Generate::Accessor::
1 | 1 | 1 | 12µs | 89µs | BEGIN@4 | Method::Generate::Accessor::
1 | 1 | 1 | 12µs | 40µs | BEGIN@8 | Method::Generate::Accessor::
4 | 2 | 1 | 11µs | 11µs | is_simple_set | Method::Generate::Accessor::
1 | 1 | 1 | 11µs | 29µs | BEGIN@10 | Method::Generate::Accessor::
1 | 1 | 1 | 10µs | 51µs | BEGIN@6 | Method::Generate::Accessor::
1 | 1 | 1 | 9µs | 42µs | BEGIN@7 | Method::Generate::Accessor::
2 | 1 | 1 | 9µs | 11µs | _generate_simple_get | Method::Generate::Accessor::
1 | 1 | 1 | 9µs | 85µs | BEGIN@5 | Method::Generate::Accessor::
1 | 1 | 1 | 9µs | 9µs | BEGIN@9 | Method::Generate::Accessor::
4 | 2 | 1 | 8µs | 8µs | is_simple_get | Method::Generate::Accessor::
3 | 1 | 1 | 3µs | 3µs | default_construction_string | Method::Generate::Accessor::
2 | 1 | 1 | 800ns | 800ns | CORE:subst (opcode) | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _SIGDIE | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | __ANON__[:26] | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _attr_desc | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _die_overwrite | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_asserter | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_coerce | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_delegation | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_get_default | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_simple_clear | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_simple_has | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_trigger | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_use_default | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | _generate_xs | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_coerce | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_get_default | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_isa_check | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_simple_get | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_simple_has | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_trigger | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | generate_use_default | Method::Generate::Accessor::
0 | 0 | 0 | 0s | 0s | is_simple_attribute | Method::Generate::Accessor::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Method::Generate::Accessor; | ||||
2 | |||||
3 | 3 | 40µs | 3 | 136µs | # spent 79µs (23+57) within Method::Generate::Accessor::BEGIN@3 which was called:
# once (23µs+57µs) by Moo::_accessor_maker_for at line 3 # spent 79µs making 1 call to Method::Generate::Accessor::BEGIN@3
# spent 40µs making 1 call to strictures::import
# spent 16µs making 1 call to strictures::VERSION |
4 | 2 | 37µs | 2 | 167µs | # spent 89µs (12+77) within Method::Generate::Accessor::BEGIN@4 which was called:
# once (12µs+77µs) by Moo::_accessor_maker_for at line 4 # spent 89µs making 1 call to Method::Generate::Accessor::BEGIN@4
# spent 77µs making 1 call to Exporter::import |
5 | 2 | 44µs | 2 | 161µs | # spent 85µs (9+76) within Method::Generate::Accessor::BEGIN@5 which was called:
# once (9µs+76µs) by Moo::_accessor_maker_for at line 5 # spent 85µs making 1 call to Method::Generate::Accessor::BEGIN@5
# spent 76µs making 1 call to base::import |
6 | 2 | 35µs | 2 | 92µs | # spent 51µs (10+41) within Method::Generate::Accessor::BEGIN@6 which was called:
# once (10µs+41µs) by Moo::_accessor_maker_for at line 6 # spent 51µs making 1 call to Method::Generate::Accessor::BEGIN@6
# spent 41µs making 1 call to Exporter::import |
7 | 2 | 35µs | 2 | 75µs | # spent 42µs (9+33) within Method::Generate::Accessor::BEGIN@7 which was called:
# once (9µs+33µs) by Moo::_accessor_maker_for at line 7 # spent 42µs making 1 call to Method::Generate::Accessor::BEGIN@7
# spent 33µs making 1 call to Exporter::import |
8 | 2 | 37µs | 2 | 67µs | # spent 40µs (12+28) within Method::Generate::Accessor::BEGIN@8 which was called:
# once (12µs+28µs) by Moo::_accessor_maker_for at line 8 # spent 40µs making 1 call to Method::Generate::Accessor::BEGIN@8
# spent 28µs making 1 call to Exporter::import |
9 | 2 | 33µs | 1 | 9µs | # spent 9µs within Method::Generate::Accessor::BEGIN@9 which was called:
# once (9µs+0s) by Moo::_accessor_maker_for at line 9 # spent 9µs making 1 call to Method::Generate::Accessor::BEGIN@9 |
10 | 2 | 84µs | 2 | 47µs | # spent 29µs (11+18) within Method::Generate::Accessor::BEGIN@10 which was called:
# once (11µs+18µs) by Moo::_accessor_maker_for at line 10 # spent 29µs making 1 call to Method::Generate::Accessor::BEGIN@10
# spent 18µs making 1 call to Module::Runtime::import |
11 | # spent 51µs (19+33) within Method::Generate::Accessor::BEGIN@11 which was called:
# once (19µs+33µs) by Moo::_accessor_maker_for at line 19 | ||||
12 | our $CAN_HAZ_XS = | ||||
13 | !$ENV{MOO_XS_DISABLE} | ||||
14 | && | ||||
15 | _maybe_load_module('Class::XSAccessor') | ||||
16 | && | ||||
17 | 2 | 29µs | 2 | 32µs | (eval { Class::XSAccessor->VERSION('1.07') }) # spent 20µs making 1 call to Moo::_Utils::_maybe_load_module
# spent 13µs making 1 call to UNIVERSAL::VERSION |
18 | ; | ||||
19 | 1 | 4.70ms | 1 | 51µs | } # spent 51µs making 1 call to Method::Generate::Accessor::BEGIN@11 |
20 | |||||
21 | sub _SIGDIE | ||||
22 | { | ||||
23 | our ($CurrentAttribute, $OrigSigDie); | ||||
24 | my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE | ||||
25 | ? $OrigSigDie | ||||
26 | : sub { die $_[0] }; | ||||
27 | |||||
28 | return $sigdie->(@_) if ref($_[0]); | ||||
29 | |||||
30 | my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)}); | ||||
31 | $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]"); | ||||
32 | } | ||||
33 | |||||
34 | sub _die_overwrite | ||||
35 | { | ||||
36 | my ($pkg, $method, $type) = @_; | ||||
37 | die "You cannot overwrite a locally defined method ($method) with @{[ $type || 'an accessor' ]}"; | ||||
38 | } | ||||
39 | |||||
40 | # spent 428µs (93+335) within Method::Generate::Accessor::generate_method which was called 2 times, avg 214µs/call:
# 2 times (93µs+335µs) by Moo::has at line 54 of Moo.pm, avg 214µs/call | ||||
41 | 2 | 1µs | my ($self, $into, $name, $spec, $quote_opts) = @_; | ||
42 | 2 | 8µs | 2 | 800ns | $spec->{allow_overwrite}++ if $name =~ s/^\+//; # spent 800ns making 2 calls to Method::Generate::Accessor::CORE:subst, avg 400ns/call |
43 | 2 | 1µs | die "Must have an is" unless my $is = $spec->{is}; | ||
44 | 2 | 3µs | if ($is eq 'ro') { | ||
45 | $spec->{reader} = $name unless exists $spec->{reader}; | ||||
46 | } elsif ($is eq 'rw') { | ||||
47 | $spec->{accessor} = $name unless exists $spec->{accessor} | ||||
48 | or ( $spec->{reader} and $spec->{writer} ); | ||||
49 | } elsif ($is eq 'lazy') { | ||||
50 | $spec->{reader} = $name unless exists $spec->{reader}; | ||||
51 | $spec->{lazy} = 1; | ||||
52 | $spec->{builder} ||= '_build_'.$name unless $spec->{default}; | ||||
53 | } elsif ($is eq 'rwp') { | ||||
54 | $spec->{reader} = $name unless exists $spec->{reader}; | ||||
55 | $spec->{writer} = "_set_${name}" unless exists $spec->{writer}; | ||||
56 | } elsif ($is ne 'bare') { | ||||
57 | die "Unknown is ${is}"; | ||||
58 | } | ||||
59 | 2 | 400ns | if (exists $spec->{builder}) { | ||
60 | if(ref $spec->{builder}) { | ||||
61 | $self->_validate_codulatable('builder', $spec->{builder}, | ||||
62 | "$into->$name", 'or a method name'); | ||||
63 | $spec->{builder_sub} = $spec->{builder}; | ||||
64 | $spec->{builder} = 1; | ||||
65 | } | ||||
66 | $spec->{builder} = '_build_'.$name if ($spec->{builder}||0) eq 1; | ||||
67 | die "Invalid builder for $into->$name - not a valid method name" | ||||
68 | if $spec->{builder} !~ /\A[A-Za-z_][A-Za-z0-9_]*(?:::[A-Za-z_][A-Za-z0-9_]*)*\z/; | ||||
69 | } | ||||
70 | 2 | 1µs | if (($spec->{predicate}||0) eq 1) { | ||
71 | $spec->{predicate} = $name =~ /^_/ ? "_has${name}" : "has_${name}"; | ||||
72 | } | ||||
73 | 2 | 600ns | if (($spec->{clearer}||0) eq 1) { | ||
74 | $spec->{clearer} = $name =~ /^_/ ? "_clear${name}" : "clear_${name}"; | ||||
75 | } | ||||
76 | 2 | 800ns | if (($spec->{trigger}||0) eq 1) { | ||
77 | $spec->{trigger} = quote_sub('shift->_trigger_'.$name.'(@_)'); | ||||
78 | } | ||||
79 | |||||
80 | 2 | 3µs | for my $setting (qw( isa coerce )) { | ||
81 | 4 | 2µs | next if !exists $spec->{$setting}; | ||
82 | 2 | 4µs | 2 | 24µs | $self->_validate_codulatable($setting, $spec->{$setting}, "$into->$name"); # spent 24µs making 2 calls to Method::Generate::Accessor::_validate_codulatable, avg 12µs/call |
83 | } | ||||
84 | |||||
85 | 2 | 600ns | if (exists $spec->{default}) { | ||
86 | if (!defined $spec->{default} || ref $spec->{default}) { | ||||
87 | $self->_validate_codulatable('default', $spec->{default}, "$into->$name", 'or a non-ref'); | ||||
88 | } | ||||
89 | } | ||||
90 | |||||
91 | 2 | 300ns | if (exists $spec->{moosify}) { | ||
92 | if (ref $spec->{moosify} ne 'ARRAY') { | ||||
93 | $spec->{moosify} = [$spec->{moosify}]; | ||||
94 | } | ||||
95 | |||||
96 | for my $spec (@{$spec->{moosify}}) { | ||||
97 | $self->_validate_codulatable('moosify', $spec, "$into->$name"); | ||||
98 | } | ||||
99 | } | ||||
100 | |||||
101 | 2 | 300ns | my %methods; | ||
102 | 2 | 600ns | if (my $reader = $spec->{reader}) { | ||
103 | _die_overwrite($into, $reader, 'a reader') | ||||
104 | if !$spec->{allow_overwrite} && *{_getglob("${into}::${reader}")}{CODE}; | ||||
105 | if (our $CAN_HAZ_XS && $self->is_simple_get($name, $spec)) { | ||||
106 | $methods{$reader} = $self->_generate_xs( | ||||
107 | getters => $into, $reader, $name, $spec | ||||
108 | ); | ||||
109 | } else { | ||||
110 | $self->{captures} = {}; | ||||
111 | $methods{$reader} = | ||||
112 | quote_sub "${into}::${reader}" | ||||
113 | => ' die "'.$reader.' is a read-only accessor" if @_ > 1;'."\n" | ||||
114 | .$self->_generate_get($name, $spec) | ||||
115 | => delete $self->{captures} | ||||
116 | ; | ||||
117 | } | ||||
118 | } | ||||
119 | 2 | 4µs | if (my $accessor = $spec->{accessor}) { | ||
120 | _die_overwrite($into, $accessor, 'an accessor') | ||||
121 | 2 | 4µs | 2 | 7µs | if !$spec->{allow_overwrite} && *{_getglob("${into}::${accessor}")}{CODE}; # spent 7µs making 2 calls to Moo::_Utils::_getglob, avg 3µs/call |
122 | 2 | 5µs | 4 | 12µs | if ( # spent 7µs making 2 calls to Method::Generate::Accessor::is_simple_set, avg 4µs/call
# spent 4µs making 2 calls to Method::Generate::Accessor::is_simple_get, avg 2µs/call |
123 | our $CAN_HAZ_XS | ||||
124 | && $self->is_simple_get($name, $spec) | ||||
125 | && $self->is_simple_set($name, $spec) | ||||
126 | ) { | ||||
127 | $methods{$accessor} = $self->_generate_xs( | ||||
128 | accessors => $into, $accessor, $name, $spec | ||||
129 | ); | ||||
130 | } else { | ||||
131 | 2 | 2µs | $self->{captures} = {}; | ||
132 | 2 | 8µs | 4 | 292µs | $methods{$accessor} = # spent 202µs making 2 calls to Method::Generate::Accessor::_generate_getset, avg 101µs/call
# spent 90µs making 2 calls to Sub::Quote::quote_sub, avg 45µs/call |
133 | quote_sub "${into}::${accessor}" | ||||
134 | => $self->_generate_getset($name, $spec) | ||||
135 | => delete $self->{captures} | ||||
136 | ; | ||||
137 | } | ||||
138 | } | ||||
139 | 2 | 800ns | if (my $writer = $spec->{writer}) { | ||
140 | _die_overwrite($into, $writer, 'a writer') | ||||
141 | if !$spec->{allow_overwrite} && *{_getglob("${into}::${writer}")}{CODE}; | ||||
142 | if ( | ||||
143 | our $CAN_HAZ_XS | ||||
144 | && $self->is_simple_set($name, $spec) | ||||
145 | ) { | ||||
146 | $methods{$writer} = $self->_generate_xs( | ||||
147 | setters => $into, $writer, $name, $spec | ||||
148 | ); | ||||
149 | } else { | ||||
150 | $self->{captures} = {}; | ||||
151 | $methods{$writer} = | ||||
152 | quote_sub "${into}::${writer}" | ||||
153 | => $self->_generate_set($name, $spec) | ||||
154 | => delete $self->{captures} | ||||
155 | ; | ||||
156 | } | ||||
157 | } | ||||
158 | 2 | 600ns | if (my $pred = $spec->{predicate}) { | ||
159 | _die_overwrite($into, $pred, 'a predicate') | ||||
160 | if !$spec->{allow_overwrite} && *{_getglob("${into}::${pred}")}{CODE}; | ||||
161 | $methods{$pred} = | ||||
162 | quote_sub "${into}::${pred}" => | ||||
163 | ' '.$self->_generate_simple_has('$_[0]', $name, $spec)."\n" | ||||
164 | ; | ||||
165 | } | ||||
166 | 2 | 400ns | if (my $pred = $spec->{builder_sub}) { | ||
167 | _install_coderef( "${into}::$spec->{builder}" => $spec->{builder_sub} ); | ||||
168 | } | ||||
169 | 2 | 400ns | if (my $cl = $spec->{clearer}) { | ||
170 | _die_overwrite($into, $cl, 'a clearer') | ||||
171 | if !$spec->{allow_overwrite} && *{_getglob("${into}::${cl}")}{CODE}; | ||||
172 | $methods{$cl} = | ||||
173 | quote_sub "${into}::${cl}" => | ||||
174 | $self->_generate_simple_clear('$_[0]', $name, $spec)."\n" | ||||
175 | ; | ||||
176 | } | ||||
177 | 2 | 400ns | if (my $hspec = $spec->{handles}) { | ||
178 | my $asserter = $spec->{asserter} ||= '_assert_'.$name; | ||||
179 | my @specs = do { | ||||
180 | if (ref($hspec) eq 'ARRAY') { | ||||
181 | map [ $_ => $_ ], @$hspec; | ||||
182 | } elsif (ref($hspec) eq 'HASH') { | ||||
183 | map [ $_ => ref($hspec->{$_}) ? @{$hspec->{$_}} : $hspec->{$_} ], | ||||
184 | keys %$hspec; | ||||
185 | } elsif (!ref($hspec)) { | ||||
186 | map [ $_ => $_ ], use_module('Role::Tiny')->methods_provided_by(use_module($hspec)) | ||||
187 | } else { | ||||
188 | die "You gave me a handles of ${hspec} and I have no idea why"; | ||||
189 | } | ||||
190 | }; | ||||
191 | foreach my $delegation_spec (@specs) { | ||||
192 | my ($proxy, $target, @args) = @$delegation_spec; | ||||
193 | _die_overwrite($into, $proxy, 'a delegation') | ||||
194 | if !$spec->{allow_overwrite} && *{_getglob("${into}::${proxy}")}{CODE}; | ||||
195 | $self->{captures} = {}; | ||||
196 | $methods{$proxy} = | ||||
197 | quote_sub "${into}::${proxy}" => | ||||
198 | $self->_generate_delegation($asserter, $target, \@args), | ||||
199 | delete $self->{captures} | ||||
200 | ; | ||||
201 | } | ||||
202 | } | ||||
203 | 2 | 400ns | if (my $asserter = $spec->{asserter}) { | ||
204 | $self->{captures} = {}; | ||||
205 | |||||
206 | |||||
207 | $methods{$asserter} = | ||||
208 | quote_sub "${into}::${asserter}" => $self->_generate_asserter($name, $spec), | ||||
209 | delete $self->{captures} | ||||
210 | ; | ||||
211 | } | ||||
212 | 2 | 7µs | \%methods; | ||
213 | } | ||||
214 | |||||
215 | sub is_simple_attribute { | ||||
216 | my ($self, $name, $spec) = @_; | ||||
217 | # clearer doesn't have to be listed because it doesn't | ||||
218 | # affect whether defined/exists makes a difference | ||||
219 | !grep $spec->{$_}, | ||||
220 | qw(lazy default builder coerce isa trigger predicate weak_ref); | ||||
221 | } | ||||
222 | |||||
223 | sub is_simple_get { | ||||
224 | 4 | 1µs | my ($self, $name, $spec) = @_; | ||
225 | 4 | 12µs | !($spec->{lazy} and ($spec->{default} or $spec->{builder})); | ||
226 | } | ||||
227 | |||||
228 | sub is_simple_set { | ||||
229 | 4 | 1µs | my ($self, $name, $spec) = @_; | ||
230 | 4 | 21µs | !grep $spec->{$_}, qw(coerce isa trigger weak_ref); | ||
231 | } | ||||
232 | |||||
233 | # spent 13µs within Method::Generate::Accessor::has_eager_default which was called 7 times, avg 2µs/call:
# 7 times (13µs+0s) by Method::Generate::Accessor::_generate_populate_set at line 460, avg 2µs/call | ||||
234 | 7 | 2µs | my ($self, $name, $spec) = @_; | ||
235 | 7 | 23µs | (!$spec->{lazy} and (exists $spec->{default} or $spec->{builder})); | ||
236 | } | ||||
237 | |||||
238 | # spent 30µs (16+14) within Method::Generate::Accessor::_generate_get which was called 2 times, avg 15µs/call:
# 2 times (16µs+14µs) by Method::Generate::Accessor::_generate_getset at line 571, avg 15µs/call | ||||
239 | 2 | 800ns | my ($self, $name, $spec) = @_; | ||
240 | 2 | 2µs | 2 | 11µs | my $simple = $self->_generate_simple_get('$_[0]', $name, $spec); # spent 11µs making 2 calls to Method::Generate::Accessor::_generate_simple_get, avg 5µs/call |
241 | 2 | 7µs | 2 | 4µs | if ($self->is_simple_get($name, $spec)) { # spent 4µs making 2 calls to Method::Generate::Accessor::is_simple_get, avg 2µs/call |
242 | $simple; | ||||
243 | } else { | ||||
244 | $self->_generate_use_default( | ||||
245 | '$_[0]', $name, $spec, | ||||
246 | $self->_generate_simple_has('$_[0]', $name, $spec), | ||||
247 | ); | ||||
248 | } | ||||
249 | } | ||||
250 | |||||
251 | sub generate_simple_has { | ||||
252 | my $self = shift; | ||||
253 | $self->{captures} = {}; | ||||
254 | my $code = $self->_generate_simple_has(@_); | ||||
255 | ($code, delete $self->{captures}); | ||||
256 | } | ||||
257 | |||||
258 | sub _generate_simple_has { | ||||
259 | my ($self, $me, $name) = @_; | ||||
260 | "exists ${me}->{${\perlstring $name}}"; | ||||
261 | } | ||||
262 | |||||
263 | sub _generate_simple_clear { | ||||
264 | my ($self, $me, $name) = @_; | ||||
265 | " delete ${me}->{${\perlstring $name}}\n" | ||||
266 | } | ||||
267 | |||||
268 | sub generate_get_default { | ||||
269 | my $self = shift; | ||||
270 | $self->{captures} = {}; | ||||
271 | my $code = $self->_generate_get_default(@_); | ||||
272 | ($code, delete $self->{captures}); | ||||
273 | } | ||||
274 | |||||
275 | sub generate_use_default { | ||||
276 | my $self = shift; | ||||
277 | $self->{captures} = {}; | ||||
278 | my $code = $self->_generate_use_default(@_); | ||||
279 | ($code, delete $self->{captures}); | ||||
280 | } | ||||
281 | |||||
282 | sub _generate_use_default { | ||||
283 | my ($self, $me, $name, $spec, $test) = @_; | ||||
284 | my $get_value = $self->_generate_get_default($me, $name, $spec); | ||||
285 | if ($spec->{coerce}) { | ||||
286 | $get_value = $self->_generate_coerce( | ||||
287 | $name, $get_value, | ||||
288 | $spec->{coerce} | ||||
289 | ) | ||||
290 | } | ||||
291 | $test." ? \n" | ||||
292 | .$self->_generate_simple_get($me, $name, $spec)."\n:" | ||||
293 | .($spec->{isa} | ||||
294 | ? " do {\n my \$value = ".$get_value.";\n" | ||||
295 | ." ".$self->_generate_isa_check($name, '$value', $spec->{isa}).";\n" | ||||
296 | ." ".$self->_generate_simple_set($me, $name, $spec, '$value')."\n" | ||||
297 | ." }\n" | ||||
298 | : ' ('.$self->_generate_simple_set($me, $name, $spec, $get_value).")\n"); | ||||
299 | } | ||||
300 | |||||
301 | sub _generate_get_default { | ||||
302 | my ($self, $me, $name, $spec) = @_; | ||||
303 | if (exists $spec->{default}) { | ||||
304 | ref $spec->{default} | ||||
305 | ? $self->_generate_call_code($name, 'default', $me, $spec->{default}) | ||||
306 | : perlstring $spec->{default}; | ||||
307 | } | ||||
308 | else { | ||||
309 | "${me}->${\$spec->{builder}}" | ||||
310 | } | ||||
311 | } | ||||
312 | |||||
313 | sub generate_simple_get { | ||||
314 | my ($self, @args) = @_; | ||||
315 | $self->_generate_simple_get(@args); | ||||
316 | } | ||||
317 | |||||
318 | # spent 11µs (9+2) within Method::Generate::Accessor::_generate_simple_get which was called 2 times, avg 5µs/call:
# 2 times (9µs+2µs) by Method::Generate::Accessor::_generate_get at line 240, avg 5µs/call | ||||
319 | 2 | 800ns | my ($self, $me, $name) = @_; | ||
320 | 2 | 7µs | 2 | 2µs | my $name_str = perlstring $name; # spent 2µs making 2 calls to B::perlstring, avg 750ns/call |
321 | 2 | 7µs | "${me}->{${name_str}}"; | ||
322 | } | ||||
323 | |||||
324 | # spent 155µs (41+114) within Method::Generate::Accessor::_generate_set which was called 2 times, avg 78µs/call:
# 2 times (41µs+114µs) by Method::Generate::Accessor::_generate_getset at line 571, avg 78µs/call | ||||
325 | 2 | 500ns | my ($self, $name, $spec) = @_; | ||
326 | 2 | 7µs | 2 | 4µs | if ($self->is_simple_set($name, $spec)) { # spent 4µs making 2 calls to Method::Generate::Accessor::is_simple_set, avg 2µs/call |
327 | $self->_generate_simple_set('$_[0]', $name, $spec, '$_[1]'); | ||||
328 | } else { | ||||
329 | 2 | 2µs | my ($coerce, $trigger, $isa_check) = @{$spec}{qw(coerce trigger isa)}; | ||
330 | 2 | 500ns | my $value_store = '$_[0]'; | ||
331 | 2 | 200ns | my $code; | ||
332 | 2 | 300ns | if ($coerce) { | ||
333 | $value_store = '$value'; | ||||
334 | $code = "do { my (\$self, \$value) = \@_;\n" | ||||
335 | ." \$value = " | ||||
336 | .$self->_generate_coerce($name, $value_store, $coerce).";\n"; | ||||
337 | } | ||||
338 | else { | ||||
339 | 2 | 700ns | $code = "do { my \$self = shift;\n"; | ||
340 | } | ||||
341 | 2 | 8µs | 2 | 83µs | if ($isa_check) { # spent 83µs making 2 calls to Method::Generate::Accessor::_generate_isa_check, avg 42µs/call |
342 | $code .= | ||||
343 | " ".$self->_generate_isa_check($name, $value_store, $isa_check).";\n"; | ||||
344 | } | ||||
345 | 2 | 3µs | 2 | 27µs | my $simple = $self->_generate_simple_set('$self', $name, $spec, $value_store); # spent 27µs making 2 calls to Method::Generate::Accessor::_generate_simple_set, avg 13µs/call |
346 | 2 | 300ns | if ($trigger) { | ||
347 | my $fire = $self->_generate_trigger($name, '$self', $value_store, $trigger); | ||||
348 | $code .= | ||||
349 | " ".$simple.";\n ".$fire.";\n" | ||||
350 | ." $value_store;\n"; | ||||
351 | } else { | ||||
352 | 2 | 2µs | $code .= " ".$simple.";\n"; | ||
353 | } | ||||
354 | 2 | 200ns | $code .= " }"; | ||
355 | 2 | 1µs | $code; | ||
356 | } | ||||
357 | } | ||||
358 | |||||
359 | sub generate_coerce { | ||||
360 | my $self = shift; | ||||
361 | $self->{captures} = {}; | ||||
362 | my $code = $self->_generate_coerce(@_); | ||||
363 | ($code, delete $self->{captures}); | ||||
364 | } | ||||
365 | |||||
366 | sub _attr_desc { | ||||
367 | my ($name, $init_arg) = @_; | ||||
368 | return perlstring($name) if !defined($init_arg) or $init_arg eq $name; | ||||
369 | return perlstring($name).' (constructor argument: '.perlstring($init_arg).')'; | ||||
370 | } | ||||
371 | |||||
372 | sub _generate_coerce { | ||||
373 | my ($self, $name, $value, $coerce, $init_arg) = @_; | ||||
374 | $self->_generate_die_prefix( | ||||
375 | $name, | ||||
376 | "coercion", | ||||
377 | $init_arg, | ||||
378 | $self->_generate_call_code($name, 'coerce', "${value}", $coerce) | ||||
379 | ); | ||||
380 | } | ||||
381 | |||||
382 | sub generate_trigger { | ||||
383 | my $self = shift; | ||||
384 | $self->{captures} = {}; | ||||
385 | my $code = $self->_generate_trigger(@_); | ||||
386 | ($code, delete $self->{captures}); | ||||
387 | } | ||||
388 | |||||
389 | sub _generate_trigger { | ||||
390 | my ($self, $name, $obj, $value, $trigger) = @_; | ||||
391 | $self->_generate_call_code($name, 'trigger', "${obj}, ${value}", $trigger); | ||||
392 | } | ||||
393 | |||||
394 | sub generate_isa_check { | ||||
395 | my ($self, @args) = @_; | ||||
396 | $self->{captures} = {}; | ||||
397 | my $code = $self->_generate_isa_check(@args); | ||||
398 | ($code, delete $self->{captures}); | ||||
399 | } | ||||
400 | |||||
401 | # spent 44µs (35+9) within Method::Generate::Accessor::_generate_die_prefix which was called 4 times, avg 11µs/call:
# 4 times (35µs+9µs) by Method::Generate::Accessor::_generate_isa_check at line 417, avg 11µs/call | ||||
402 | 4 | 4µs | my ($self, $name, $prefix, $arg, $inside) = @_; | ||
403 | 4 | 44µs | 10 | 9µs | "do {\n" # spent 9µs making 10 calls to B::perlstring, avg 860ns/call |
404 | .' local $Method::Generate::Accessor::CurrentAttribute = {' | ||||
405 | .' init_arg => '.(defined $arg ? B::perlstring($arg) : 'undef') . ",\n" | ||||
406 | .' name => '.B::perlstring($name).",\n" | ||||
407 | .' step => '.B::perlstring($prefix).",\n" | ||||
408 | ." };\n" | ||||
409 | .' local $Method::Generate::Accessor::OrigSigDie = $SIG{__DIE__};'."\n" | ||||
410 | .' local $SIG{__DIE__} = \&Method::Generate::Accessor::_SIGDIE;'."\n" | ||||
411 | .$inside | ||||
412 | ."}\n" | ||||
413 | } | ||||
414 | |||||
415 | # spent 152µs (31+121) within Method::Generate::Accessor::_generate_isa_check which was called 4 times, avg 38µs/call:
# 2 times (18µs+65µs) by Method::Generate::Accessor::_generate_set at line 341, avg 42µs/call
# 2 times (13µs+56µs) by Method::Generate::Accessor::_generate_populate_set at line 495, avg 34µs/call | ||||
416 | 4 | 2µs | my ($self, $name, $value, $check, $init_arg) = @_; | ||
417 | 4 | 32µs | 8 | 121µs | $self->_generate_die_prefix( # spent 77µs making 4 calls to Method::Generate::Accessor::_generate_call_code, avg 19µs/call
# spent 44µs making 4 calls to Method::Generate::Accessor::_generate_die_prefix, avg 11µs/call |
418 | $name, | ||||
419 | "isa check", | ||||
420 | $init_arg, | ||||
421 | $self->_generate_call_code($name, 'isa_check', $value, $check) | ||||
422 | ); | ||||
423 | } | ||||
424 | |||||
425 | # spent 77µs (44+33) within Method::Generate::Accessor::_generate_call_code which was called 4 times, avg 19µs/call:
# 4 times (44µs+33µs) by Method::Generate::Accessor::_generate_isa_check at line 417, avg 19µs/call | ||||
426 | 4 | 2µs | my ($self, $name, $type, $values, $sub) = @_; | ||
427 | 4 | 12µs | 4 | 2µs | $sub = \&{$sub} if blessed($sub); # coderef if blessed # spent 2µs making 4 calls to Scalar::Util::blessed, avg 600ns/call |
428 | 4 | 15µs | 4 | 10µs | if (my $quoted = quoted_from_sub($sub)) { # spent 10µs making 4 calls to Sub::Quote::quoted_from_sub, avg 2µs/call |
429 | 2 | 300ns | my $local = 1; | ||
430 | 2 | 900ns | if ($values eq '@_' || $values eq '$_[0]') { | ||
431 | 1 | 100ns | $local = 0; | ||
432 | 1 | 100ns | $values = '@_'; | ||
433 | } | ||||
434 | 2 | 1µs | my $code = $quoted->[1]; | ||
435 | 2 | 900ns | if (my $captures = $quoted->[2]) { | ||
436 | my $cap_name = qq{\$${type}_captures_for_${name}}; | ||||
437 | $self->{captures}->{$cap_name} = \$captures; | ||||
438 | Sub::Quote::inlinify( | ||||
439 | $code, $values, Sub::Quote::capture_unroll($cap_name, $captures, 6), $local | ||||
440 | ); | ||||
441 | } else { | ||||
442 | 2 | 3µs | 2 | 21µs | Sub::Quote::inlinify($code, $values, undef, $local); # spent 21µs making 2 calls to Sub::Quote::inlinify, avg 10µs/call |
443 | } | ||||
444 | } else { | ||||
445 | 2 | 2µs | my $cap_name = qq{\$${type}_for_${name}}; | ||
446 | 2 | 2µs | $self->{captures}->{$cap_name} = \$sub; | ||
447 | 2 | 2µs | "${cap_name}->(${values})"; | ||
448 | } | ||||
449 | } | ||||
450 | |||||
451 | # spent 305µs (44+261) within Method::Generate::Accessor::generate_populate_set which was called 7 times, avg 44µs/call:
# 7 times (44µs+261µs) by Method::Generate::Constructor::_assign_new at line 165 of Method/Generate/Constructor.pm, avg 44µs/call | ||||
452 | 7 | 1µs | my $self = shift; | ||
453 | 7 | 7µs | $self->{captures} = {}; | ||
454 | 7 | 11µs | 7 | 261µs | my $code = $self->_generate_populate_set(@_); # spent 261µs making 7 calls to Method::Generate::Accessor::_generate_populate_set, avg 37µs/call |
455 | 7 | 21µs | ($code, delete $self->{captures}); | ||
456 | } | ||||
457 | |||||
458 | # spent 261µs (78+182) within Method::Generate::Accessor::_generate_populate_set which was called 7 times, avg 37µs/call:
# 7 times (78µs+182µs) by Method::Generate::Accessor::generate_populate_set at line 454, avg 37µs/call | ||||
459 | 7 | 4µs | my ($self, $me, $name, $spec, $source, $test, $init_arg) = @_; | ||
460 | 7 | 23µs | 7 | 13µs | if ($self->has_eager_default($name, $spec)) { # spent 13µs making 7 calls to Method::Generate::Accessor::has_eager_default, avg 2µs/call |
461 | my $get_indent = ' ' x ($spec->{isa} ? 6 : 4); | ||||
462 | my $get_default = $self->_generate_get_default( | ||||
463 | '$new', $name, $spec | ||||
464 | ); | ||||
465 | my $get_value = | ||||
466 | defined($spec->{init_arg}) | ||||
467 | ? "(\n${get_indent} ${test}\n${get_indent} ? ${source}\n${get_indent} : " | ||||
468 | .$get_default | ||||
469 | ."\n${get_indent})" | ||||
470 | : $get_default; | ||||
471 | if ($spec->{coerce}) { | ||||
472 | $get_value = $self->_generate_coerce( | ||||
473 | $name, $get_value, | ||||
474 | $spec->{coerce}, $init_arg | ||||
475 | ) | ||||
476 | } | ||||
477 | ($spec->{isa} | ||||
478 | ? " {\n my \$value = ".$get_value.";\n " | ||||
479 | .$self->_generate_isa_check( | ||||
480 | $name, '$value', $spec->{isa}, $init_arg | ||||
481 | ).";\n" | ||||
482 | .' '.$self->_generate_simple_set($me, $name, $spec, '$value').";\n" | ||||
483 | ." }\n" | ||||
484 | : ' '.$self->_generate_simple_set($me, $name, $spec, $get_value).";\n" | ||||
485 | ) | ||||
486 | .($spec->{trigger} | ||||
487 | ? ' ' | ||||
488 | .$self->_generate_trigger( | ||||
489 | $name, $me, $self->_generate_simple_get($me, $name, $spec), | ||||
490 | $spec->{trigger} | ||||
491 | )." if ${test};\n" | ||||
492 | : '' | ||||
493 | ); | ||||
494 | } else { | ||||
495 | 7 | 24µs | 9 | 169µs | " if (${test}) {\n" # spent 101µs making 7 calls to Method::Generate::Accessor::_generate_simple_set, avg 14µs/call
# spent 68µs making 2 calls to Method::Generate::Accessor::_generate_isa_check, avg 34µs/call |
496 | .($spec->{coerce} | ||||
497 | ? " $source = " | ||||
498 | .$self->_generate_coerce( | ||||
499 | $name, $source, | ||||
500 | $spec->{coerce}, $init_arg | ||||
501 | ).";\n" | ||||
502 | : "" | ||||
503 | ) | ||||
504 | .($spec->{isa} | ||||
505 | ? " " | ||||
506 | .$self->_generate_isa_check( | ||||
507 | $name, $source, $spec->{isa}, $init_arg | ||||
508 | ).";\n" | ||||
509 | : "" | ||||
510 | ) | ||||
511 | ." ".$self->_generate_simple_set($me, $name, $spec, $source).";\n" | ||||
512 | .($spec->{trigger} | ||||
513 | ? " " | ||||
514 | .$self->_generate_trigger( | ||||
515 | $name, $me, $self->_generate_simple_get($me, $name, $spec), | ||||
516 | $spec->{trigger} | ||||
517 | ).";\n" | ||||
518 | : "" | ||||
519 | ) | ||||
520 | ." }\n"; | ||||
521 | } | ||||
522 | } | ||||
523 | |||||
524 | # spent 49µs (41+8) within Method::Generate::Accessor::_generate_core_set which was called 9 times, avg 5µs/call:
# 9 times (41µs+8µs) by Method::Generate::Accessor::_generate_simple_set at line 533, avg 5µs/call | ||||
525 | 9 | 4µs | my ($self, $me, $name, $spec, $value) = @_; | ||
526 | 9 | 26µs | 9 | 8µs | my $name_str = perlstring $name; # spent 8µs making 9 calls to B::perlstring, avg 889ns/call |
527 | 9 | 27µs | "${me}->{${name_str}} = ${value}"; | ||
528 | } | ||||
529 | |||||
530 | # spent 128µs (70+58) within Method::Generate::Accessor::_generate_simple_set which was called 9 times, avg 14µs/call:
# 7 times (54µs+47µs) by Method::Generate::Accessor::_generate_populate_set at line 495, avg 14µs/call
# 2 times (16µs+11µs) by Method::Generate::Accessor::_generate_set at line 345, avg 13µs/call | ||||
531 | 9 | 5µs | my ($self, $me, $name, $spec, $value) = @_; | ||
532 | 9 | 30µs | 9 | 9µs | my $name_str = perlstring $name; # spent 9µs making 9 calls to B::perlstring, avg 1µs/call |
533 | 9 | 11µs | 9 | 49µs | my $simple = $self->_generate_core_set($me, $name, $spec, $value); # spent 49µs making 9 calls to Method::Generate::Accessor::_generate_core_set, avg 5µs/call |
534 | |||||
535 | 9 | 27µs | if ($spec->{weak_ref}) { | ||
536 | require Scalar::Util; | ||||
537 | my $get = $self->_generate_simple_get($me, $name, $spec); | ||||
538 | |||||
539 | # Perl < 5.8.3 can't weaken refs to readonly vars | ||||
540 | # (e.g. string constants). This *can* be solved by: | ||||
541 | # | ||||
542 | #Internals::SetReadWrite($foo); | ||||
543 | #Scalar::Util::weaken ($foo); | ||||
544 | #Internals::SetReadOnly($foo); | ||||
545 | # | ||||
546 | # but requires XS and is just too damn crazy | ||||
547 | # so simply throw a better exception | ||||
548 | my $weak_simple = "do { Scalar::Util::weaken(${simple}); no warnings 'void'; $get }"; | ||||
549 | Moo::_Utils::lt_5_8_3() ? <<"EOC" : $weak_simple; | ||||
550 | eval { Scalar::Util::weaken($simple); 1 } | ||||
551 | ? do { no warnings 'void'; $get } | ||||
552 | : do { | ||||
553 | if( \$@ =~ /Modification of a read-only value attempted/) { | ||||
554 | require Carp; | ||||
555 | Carp::croak( sprintf ( | ||||
556 | 'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3', | ||||
557 | $name_str, | ||||
558 | ) ); | ||||
559 | } else { | ||||
560 | die \$@; | ||||
561 | } | ||||
562 | } | ||||
563 | EOC | ||||
564 | } else { | ||||
565 | 9 | 4µs | $simple; | ||
566 | } | ||||
567 | } | ||||
568 | |||||
569 | # spent 202µs (16+186) within Method::Generate::Accessor::_generate_getset which was called 2 times, avg 101µs/call:
# 2 times (16µs+186µs) by Method::Generate::Accessor::generate_method at line 132, avg 101µs/call | ||||
570 | 2 | 700ns | my ($self, $name, $spec) = @_; | ||
571 | 2 | 11µs | 4 | 186µs | q{(@_ > 1}."\n ? ".$self->_generate_set($name, $spec) # spent 155µs making 2 calls to Method::Generate::Accessor::_generate_set, avg 78µs/call
# spent 30µs making 2 calls to Method::Generate::Accessor::_generate_get, avg 15µs/call |
572 | ."\n : ".$self->_generate_get($name, $spec)."\n )"; | ||||
573 | } | ||||
574 | |||||
575 | sub _generate_asserter { | ||||
576 | my ($self, $name, $spec) = @_; | ||||
577 | |||||
578 | "do {\n" | ||||
579 | ." my \$val = ".$self->_generate_get($name, $spec).";\n" | ||||
580 | ." unless (".$self->_generate_simple_has('$_[0]', $name, $spec).") {\n" | ||||
581 | .qq! die "Attempted to access '${name}' but it is not set";\n! | ||||
582 | ." }\n" | ||||
583 | ." \$val;\n" | ||||
584 | ."}\n"; | ||||
585 | } | ||||
586 | sub _generate_delegation { | ||||
587 | my ($self, $asserter, $target, $args) = @_; | ||||
588 | my $arg_string = do { | ||||
589 | if (@$args) { | ||||
590 | # I could, I reckon, linearise out non-refs here using perlstring | ||||
591 | # plus something to check for numbers but I'm unsure if it's worth it | ||||
592 | $self->{captures}{'@curries'} = $args; | ||||
593 | '@curries, @_'; | ||||
594 | } else { | ||||
595 | '@_'; | ||||
596 | } | ||||
597 | }; | ||||
598 | "shift->${asserter}->${target}(${arg_string});"; | ||||
599 | } | ||||
600 | |||||
601 | sub _generate_xs { | ||||
602 | my ($self, $type, $into, $name, $slot) = @_; | ||||
603 | Class::XSAccessor->import( | ||||
604 | class => $into, | ||||
605 | $type => { $name => $slot }, | ||||
606 | replace => 1, | ||||
607 | ); | ||||
608 | $into->can($name); | ||||
609 | } | ||||
610 | |||||
611 | 3 | 7µs | # spent 3µs within Method::Generate::Accessor::default_construction_string which was called 3 times, avg 1µs/call:
# 3 times (3µs+0s) by Method::Generate::Constructor::_build_construction_string at line 52 of Method/Generate/Constructor.pm, avg 1µs/call | ||
612 | |||||
613 | # spent 24µs (19+4) within Method::Generate::Accessor::_validate_codulatable which was called 2 times, avg 12µs/call:
# 2 times (19µs+4µs) by Method::Generate::Accessor::generate_method at line 82, avg 12µs/call | ||||
614 | 2 | 2µs | my ($self, $setting, $value, $into, $appended) = @_; | ||
615 | 2 | 6µs | 2 | 4µs | my $invalid = "Invalid $setting '" . overload::StrVal($value) # spent 4µs making 2 calls to overload::AddrRef, avg 2µs/call |
616 | . "' for $into not a coderef"; | ||||
617 | 2 | 200ns | $invalid .= " $appended" if $appended; | ||
618 | |||||
619 | 2 | 2µs | unless (ref $value and (ref $value eq 'CODE' or blessed($value))) { | ||
620 | die "$invalid or code-convertible object"; | ||||
621 | } | ||||
622 | |||||
623 | 4 | 2µs | unless (eval { \&$value }) { | ||
624 | die "$invalid and could not be converted to a coderef: $@"; | ||||
625 | } | ||||
626 | |||||
627 | 2 | 11µs | 1; | ||
628 | } | ||||
629 | |||||
630 | 1 | 3µs | 1; | ||
# spent 800ns within Method::Generate::Accessor::CORE:subst which was called 2 times, avg 400ns/call:
# 2 times (800ns+0s) by Method::Generate::Accessor::generate_method at line 42, avg 400ns/call |