← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:05 2021

Filename/usr/local/lib/perl5/site_perl/Specio/Constraint/Role/Interface.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@10Specio::Constraint::Role::Interface::BEGIN@10
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@11Specio::Constraint::Role::Interface::BEGIN@11
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@12Specio::Constraint::Role::Interface::BEGIN@12
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@13Specio::Constraint::Role::Interface::BEGIN@13
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@15Specio::Constraint::Role::Interface::BEGIN@15
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@17Specio::Constraint::Role::Interface::BEGIN@17
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@20Specio::Constraint::Role::Interface::BEGIN@20
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@3Specio::Constraint::Role::Interface::BEGIN@3
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@4Specio::Constraint::Role::Interface::BEGIN@4
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@8Specio::Constraint::Role::Interface::BEGIN@8
0000s0sSpecio::Constraint::Role::Interface::::BEGIN@9Specio::Constraint::Role::Interface::BEGIN@9
0000s0sSpecio::Constraint::Role::Interface::::_Specio_Constraint_Role_Interface_BUILDSpecio::Constraint::Role::Interface::_Specio_Constraint_Role_Interface_BUILD
0000s0sSpecio::Constraint::Role::Interface::::__ANON__Specio::Constraint::Role::Interface::__ANON__ (xsub)
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:125]Specio::Constraint::Role::Interface::__ANON__[:125]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:130]Specio::Constraint::Role::Interface::__ANON__[:130]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:169]Specio::Constraint::Role::Interface::__ANON__[:169]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:224]Specio::Constraint::Role::Interface::__ANON__[:224]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:23]Specio::Constraint::Role::Interface::__ANON__[:23]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:266]Specio::Constraint::Role::Interface::__ANON__[:266]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:267]Specio::Constraint::Role::Interface::__ANON__[:267]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:316]Specio::Constraint::Role::Interface::__ANON__[:316]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:322]Specio::Constraint::Role::Interface::__ANON__[:322]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:441]Specio::Constraint::Role::Interface::__ANON__[:441]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:464]Specio::Constraint::Role::Interface::__ANON__[:464]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:488]Specio::Constraint::Role::Interface::__ANON__[:488]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:587]Specio::Constraint::Role::Interface::__ANON__[:587]
0000s0sSpecio::Constraint::Role::Interface::::__ANON__[:90]Specio::Constraint::Role::Interface::__ANON__[:90]
0000s0sSpecio::Constraint::Role::Interface::::_add_coercionSpecio::Constraint::Role::Interface::_add_coercion
0000s0sSpecio::Constraint::Role::Interface::::_ancestors_and_selfSpecio::Constraint::Role::Interface::_ancestors_and_self
0000s0sSpecio::Constraint::Role::Interface::::_attrsSpecio::Constraint::Role::Interface::_attrs
0000s0sSpecio::Constraint::Role::Interface::::_build_ancestorsSpecio::Constraint::Role::Interface::_build_ancestors
0000s0sSpecio::Constraint::Role::Interface::::_build_coercionsSpecio::Constraint::Role::Interface::_build_coercions
0000s0sSpecio::Constraint::Role::Interface::::_build_descriptionSpecio::Constraint::Role::Interface::_build_description
0000s0sSpecio::Constraint::Role::Interface::::_build_generated_inline_subSpecio::Constraint::Role::Interface::_build_generated_inline_sub
0000s0sSpecio::Constraint::Role::Interface::::_build_optimized_constraintSpecio::Constraint::Role::Interface::_build_optimized_constraint
0000s0sSpecio::Constraint::Role::Interface::::_build_signatureSpecio::Constraint::Role::Interface::_build_signature
0000s0sSpecio::Constraint::Role::Interface::::_build_subificationSpecio::Constraint::Role::Interface::_build_subification
0000s0sSpecio::Constraint::Role::Interface::::_clone_coercionsSpecio::Constraint::Role::Interface::_clone_coercions
0000s0sSpecio::Constraint::Role::Interface::::_compiled_type_coercionSpecio::Constraint::Role::Interface::_compiled_type_coercion
0000s0sSpecio::Constraint::Role::Interface::::_compiled_type_constraintSpecio::Constraint::Role::Interface::_compiled_type_constraint
0000s0sSpecio::Constraint::Role::Interface::::_constraint_with_parentsSpecio::Constraint::Role::Interface::_constraint_with_parents
0000s0sSpecio::Constraint::Role::Interface::::_has_coercion_from_typeSpecio::Constraint::Role::Interface::_has_coercion_from_type
0000s0sSpecio::Constraint::Role::Interface::::_inline_checkSpecio::Constraint::Role::Interface::_inline_check
0000s0sSpecio::Constraint::Role::Interface::::_inline_coercionSpecio::Constraint::Role::Interface::_inline_coercion
0000s0sSpecio::Constraint::Role::Interface::::_inline_throw_exceptionSpecio::Constraint::Role::Interface::_inline_throw_exception
0000s0sSpecio::Constraint::Role::Interface::::_self_or_first_inlinable_ancestorSpecio::Constraint::Role::Interface::_self_or_first_inlinable_ancestor
0000s0sSpecio::Constraint::Role::Interface::::_stringifySpecio::Constraint::Role::Interface::_stringify
0000s0sSpecio::Constraint::Role::Interface::::_subifySpecio::Constraint::Role::Interface::_subify
0000s0sSpecio::Constraint::Role::Interface::::_wrap_message_generatorSpecio::Constraint::Role::Interface::_wrap_message_generator
0000s0sSpecio::Constraint::Role::Interface::::add_coercionSpecio::Constraint::Role::Interface::add_coercion
0000s0sSpecio::Constraint::Role::Interface::::can_be_inlinedSpecio::Constraint::Role::Interface::can_be_inlined
0000s0sSpecio::Constraint::Role::Interface::::can_inline_coercionSpecio::Constraint::Role::Interface::can_inline_coercion
0000s0sSpecio::Constraint::Role::Interface::::can_inline_coercion_and_checkSpecio::Constraint::Role::Interface::can_inline_coercion_and_check
0000s0sSpecio::Constraint::Role::Interface::::checkSpecio::Constraint::Role::Interface::check
0000s0sSpecio::Constraint::Role::Interface::::coerceSpecio::Constraint::Role::Interface::coerce
0000s0sSpecio::Constraint::Role::Interface::::coerce_valueSpecio::Constraint::Role::Interface::coerce_value
0000s0sSpecio::Constraint::Role::Interface::::coercionSpecio::Constraint::Role::Interface::coercion
0000s0sSpecio::Constraint::Role::Interface::::coercion_from_typeSpecio::Constraint::Role::Interface::coercion_from_type
0000s0sSpecio::Constraint::Role::Interface::::coercion_subSpecio::Constraint::Role::Interface::coercion_sub
0000s0sSpecio::Constraint::Role::Interface::::coercionsSpecio::Constraint::Role::Interface::coercions
0000s0sSpecio::Constraint::Role::Interface::::get_messageSpecio::Constraint::Role::Interface::get_message
0000s0sSpecio::Constraint::Role::Interface::::has_coercionSpecio::Constraint::Role::Interface::has_coercion
0000s0sSpecio::Constraint::Role::Interface::::has_coercion_from_typeSpecio::Constraint::Role::Interface::has_coercion_from_type
0000s0sSpecio::Constraint::Role::Interface::::has_coercionsSpecio::Constraint::Role::Interface::has_coercions
0000s0sSpecio::Constraint::Role::Interface::::has_messageSpecio::Constraint::Role::Interface::has_message
0000s0sSpecio::Constraint::Role::Interface::::has_real_constraintSpecio::Constraint::Role::Interface::has_real_constraint
0000s0sSpecio::Constraint::Role::Interface::::idSpecio::Constraint::Role::Interface::id
0000s0sSpecio::Constraint::Role::Interface::::inline_assertSpecio::Constraint::Role::Interface::inline_assert
0000s0sSpecio::Constraint::Role::Interface::::inline_checkSpecio::Constraint::Role::Interface::inline_check
0000s0sSpecio::Constraint::Role::Interface::::inline_coercionSpecio::Constraint::Role::Interface::inline_coercion
0000s0sSpecio::Constraint::Role::Interface::::inline_coercion_and_checkSpecio::Constraint::Role::Interface::inline_coercion_and_check
0000s0sSpecio::Constraint::Role::Interface::::is_a_type_ofSpecio::Constraint::Role::Interface::is_a_type_of
0000s0sSpecio::Constraint::Role::Interface::::is_anonSpecio::Constraint::Role::Interface::is_anon
0000s0sSpecio::Constraint::Role::Interface::::is_same_type_asSpecio::Constraint::Role::Interface::is_same_type_as
0000s0sSpecio::Constraint::Role::Interface::::messageSpecio::Constraint::Role::Interface::message
0000s0sSpecio::Constraint::Role::Interface::::validate_or_dieSpecio::Constraint::Role::Interface::validate_or_die
0000s0sSpecio::Constraint::Role::Interface::::value_is_validSpecio::Constraint::Role::Interface::value_is_valid
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Specio::Constraint::Role::Interface;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.47';
7
8use Carp qw( confess );
9use Eval::Closure qw( eval_closure );
10use List::Util 1.33 qw( all any first );
11use Specio::Exception;
12use Specio::PartialDump qw( partial_dump );
13use Specio::TypeChecks qw( is_CodeRef );
14
15use Role::Tiny 1.003003;
16
17use Specio::Role::Inlinable;
18with 'Specio::Role::Inlinable';
19
20use overload(
21 q{""} => '_stringify',
22 '&{}' => '_subification',
23 'bool' => sub {1},
24 'eq' => 'is_same_type_as',
25);
26
27{
28 ## no critic (Subroutines::ProtectPrivateSubs)
29 my $role_attrs = Specio::Role::Inlinable::_attrs();
30 ## use critic
31
32 my $attrs = {
33 %{$role_attrs},
34 name => {
35 isa => 'Str',
36 predicate => '_has_name',
37 },
38 parent => {
39 does => 'Specio::Constraint::Role::Interface',
40 predicate => '_has_parent',
41 },
42 _constraint => {
43 isa => 'CodeRef',
44 init_arg => 'constraint',
45 predicate => '_has_constraint',
46 },
47 _optimized_constraint => {
48 isa => 'CodeRef',
49 init_arg => undef,
50 lazy => 1,
51 builder => '_build_optimized_constraint',
52 },
53 _ancestors => {
54 isa => 'ArrayRef',
55 init_arg => undef,
56 lazy => 1,
57 builder => '_build_ancestors',
58 },
59 _message_generator => {
60 isa => 'CodeRef',
61 init_arg => undef,
62 },
63 _coercions => {
64 builder => '_build_coercions',
65 clone => '_clone_coercions',
66 },
67 _subification => {
68 init_arg => undef,
69 lazy => 1,
70 builder => '_build_subification',
71 },
72
73 # Because types are cloned on import, we can't directly compare type
74 # objects. Because type names can be reused between packages (no global
75 # registry) we can't compare types based on name either.
76 _signature => {
77 isa => 'Str',
78 init_arg => undef,
79 lazy => 1,
80 builder => '_build_signature',
81 },
82 };
83
84 ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
85 sub _attrs {
86 return $attrs;
87 }
88}
89
90my $NullConstraint = sub {1};
91
92# See Specio::OO to see how this is used.
93
94## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
95sub _Specio_Constraint_Role_Interface_BUILD {
96 my $self = shift;
97 my $p = shift;
98
99 unless ( $self->_has_constraint || $self->_has_inline_generator ) {
100 $self->{_constraint} = $NullConstraint;
101 }
102
103 die
104 'A type constraint should have either a constraint or inline_generator parameter, not both'
105 if $self->_has_constraint && $self->_has_inline_generator;
106
107 $self->{_message_generator}
108 = $self->_wrap_message_generator( $p->{message_generator} );
109
110 return;
111}
112## use critic
113
114sub _wrap_message_generator {
115 my $self = shift;
116 my $generator = shift;
117
118 unless ( defined $generator ) {
119 $generator = sub {
120 my $description = shift;
121 my $value = shift;
122
123 return "Validation failed for $description with value "
124 . partial_dump($value);
125 };
126 }
127
128 my $d = $self->description;
129
130 return sub { $generator->( $d, @_ ) };
131}
132
133sub coercions { values %{ $_[0]->{_coercions} } }
134sub coercion_from_type { $_[0]->{_coercions}{ $_[1] } }
135sub _has_coercion_from_type { exists $_[0]->{_coercions}{ $_[1] } }
136sub _add_coercion { $_[0]->{_coercions}{ $_[1] } = $_[2] }
137sub has_coercions { scalar keys %{ $_[0]->{_coercions} } }
138
139sub validate_or_die {
140 my $self = shift;
141 my $value = shift;
142
143 return if $self->value_is_valid($value);
144
145 Specio::Exception->throw(
146 message => $self->_message_generator->($value),
147 type => $self,
148 value => $value,
149 );
150}
151
152sub value_is_valid {
153 my $self = shift;
154 my $value = shift;
155
156 return $self->_optimized_constraint->($value);
157}
158
159sub _ancestors_and_self {
160 my $self = shift;
161
162 return ( ( reverse @{ $self->_ancestors } ), $self );
163}
164
165sub is_a_type_of {
166 my $self = shift;
167 my $type = shift;
168
169 return any { $_->_signature eq $type->_signature }
170 $self->_ancestors_and_self;
171}
172
173sub is_same_type_as {
174 my $self = shift;
175 my $type = shift;
176
177 return $self->_signature eq $type->_signature;
178}
179
180sub is_anon {
181 my $self = shift;
182
183 return !$self->_has_name;
184}
185
186sub has_real_constraint {
187 my $self = shift;
188
189 return ( $self->_has_constraint && $self->_constraint ne $NullConstraint )
190 || $self->_has_inline_generator;
191}
192
193sub can_be_inlined {
194 my $self = shift;
195
196 return 1 if $self->_has_inline_generator;
197 return 0
198 if $self->_has_constraint && $self->_constraint ne $NullConstraint;
199
200 # If this type is an empty subtype of an inlinable parent, then we can
201 # inline this type as well.
202 return 1 if $self->_has_parent && $self->parent->can_be_inlined;
203 return 0;
204}
205
206sub _build_generated_inline_sub {
207 my $self = shift;
208
209 my $type = $self->_self_or_first_inlinable_ancestor;
210
211 my $source
212 = 'sub { ' . $type->_inline_generator->( $type, '$_[0]' ) . '}';
213
214 return eval_closure(
215 source => $source,
216 environment => $type->inline_environment,
217 description => 'inlined sub for ' . $self->description,
218 );
219}
220
221sub _self_or_first_inlinable_ancestor {
222 my $self = shift;
223
224 my $type = first { $_->_has_inline_generator }
225 reverse $self->_ancestors_and_self;
226
227 # This should never happen because ->can_be_inlined should always be
228 # checked before this builder is called.
229 die 'Cannot generate an inline sub' unless $type;
230
231 return $type;
232}
233
234sub _build_optimized_constraint {
235 my $self = shift;
236
237 if ( $self->can_be_inlined ) {
238 return $self->_generated_inline_sub;
239 }
240 else {
241 return $self->_constraint_with_parents;
242 }
243}
244
245sub _constraint_with_parents {
246 my $self = shift;
247
248 my @constraints;
249 for my $type ( $self->_ancestors_and_self ) {
250 next unless $type->has_real_constraint;
251
252 # If a type can be inlined, we can use that and discard all of the
253 # ancestors we've seen so far, since we can assume that the inlined
254 # constraint does all of the ancestor checks in addition to its own.
255 if ( $type->can_be_inlined ) {
256 @constraints = $type->_generated_inline_sub;
257 }
258 else {
259 push @constraints, $type->_constraint;
260 }
261 }
262
263 return $NullConstraint unless @constraints;
264
265 return sub {
266 all { $_->( $_[0] ) } @constraints;
267 };
268}
269
270# This is only used for identifying from types as part of coercions, but I
271# want to leave open the possibility of using something other than
272# _description in the future.
273sub id {
274 my $self = shift;
275
276 return $self->description;
277}
278
279sub add_coercion {
280 my $self = shift;
281 my $coercion = shift;
282
283 my $from_id = $coercion->from->id;
284
285 confess "Cannot add two coercions fom the same type: $from_id"
286 if $self->_has_coercion_from_type($from_id);
287
288 $self->_add_coercion( $from_id => $coercion );
289
290 return;
291}
292
293sub has_coercion_from_type {
294 my $self = shift;
295 my $type = shift;
296
297 return $self->_has_coercion_from_type( $type->id );
298}
299
300sub coerce_value {
301 my $self = shift;
302 my $value = shift;
303
304 for my $coercion ( $self->coercions ) {
305 next unless $coercion->from->value_is_valid($value);
306
307 return $coercion->coerce($value);
308 }
309
310 return $value;
311}
312
313sub can_inline_coercion {
314 my $self = shift;
315
316 return all { $_->can_be_inlined } $self->coercions;
317}
318
319sub can_inline_coercion_and_check {
320 my $self = shift;
321
322 return all { $_->can_be_inlined } $self, $self->coercions;
323}
324
325sub inline_coercion {
326 my $self = shift;
327 my $arg_name = shift;
328
329 die 'Cannot inline coercion'
330 unless $self->can_inline_coercion;
331
332 my $source = 'do { my $value = ' . $arg_name . ';';
333
334 my ( $coerce, $env );
335 ( $coerce, $arg_name, $env ) = $self->_inline_coercion($arg_name);
336 $source .= $coerce . $arg_name . '};';
337
338 return ( $source, $env );
339}
340
341sub inline_coercion_and_check {
342 my $self = shift;
343 my $arg_name = shift;
344
345 die 'Cannot inline coercion and check'
346 unless $self->can_inline_coercion_and_check;
347
348 my $source = 'do { my $value = ' . $arg_name . ';';
349
350 my ( $coerce, $env );
351 ( $coerce, $arg_name, $env ) = $self->_inline_coercion($arg_name);
352 my ( $assert, $assert_env ) = $self->inline_assert($arg_name);
353
354 $source .= $coerce;
355 $source .= $assert;
356 $source .= $arg_name . '};';
357
358 return ( $source, { %{$env}, %{$assert_env} } );
359}
360
361sub _inline_coercion {
362 my $self = shift;
363 my $arg_name = shift;
364
365 return ( q{}, $arg_name, {} ) unless $self->has_coercions;
366
367 my %env;
368
369 $arg_name = '$value';
370 my $source = $arg_name . ' = ';
371 for my $coercion ( $self->coercions ) {
372 $source
373 .= '('
374 . $coercion->from->inline_check($arg_name) . ') ? ('
375 . $coercion->inline_coercion($arg_name) . ') : ';
376
377 %env = (
378 %env,
379 %{ $coercion->inline_environment },
380 %{ $coercion->from->inline_environment },
381 );
382 }
383 $source .= $arg_name . ';';
384
385 return ( $source, $arg_name, \%env );
386}
387
388{
389 my $counter = 1;
390
391 sub inline_assert {
392 my $self = shift;
393
394 my $type_var_name = '$_Specio_Constraint_Interface_type' . $counter;
395 my $message_generator_var_name
396 = '$_Specio_Constraint_Interface_message_generator' . $counter;
397 my %env = (
398 $type_var_name => \$self,
399 $message_generator_var_name => \( $self->_message_generator ),
400 %{ $self->inline_environment },
401 );
402
403 my $source = $self->inline_check( $_[0] );
404 $source .= ' or ';
405 $source .= $self->_inline_throw_exception(
406 $_[0],
407 $message_generator_var_name,
408 $type_var_name
409 );
410 $source .= ';';
411
412 $counter++;
413
414 return ( $source, \%env );
415 }
416}
417
418sub inline_check {
419 my $self = shift;
420
421 die 'Cannot inline' unless $self->can_be_inlined;
422
423 my $type = $self->_self_or_first_inlinable_ancestor;
424 return $type->_inline_generator->( $type, @_ );
425}
426
427# For some idiotic reason I called $type->_subify directly in Code::TidyAll so
428# I'll leave this in here for now.
429
430## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
431sub _subify { $_[0]->_subification }
432## use critic
433
434sub _build_subification {
435 my $self = shift;
436
437 if ( defined &Sub::Quote::quote_sub && $self->can_be_inlined ) {
438 return Sub::Quote::quote_sub( $self->inline_assert('$_[0]') );
439 }
440 else {
441 return sub { $self->validate_or_die( $_[0] ) };
442 }
443}
444
445sub _inline_throw_exception {
446 shift;
447 my $value_var = shift;
448 my $message_generator_var_name = shift;
449 my $type_var_name = shift;
450
451 #<<<
452 return 'Specio::Exception->throw( '
453 . ' message => ' . $message_generator_var_name . '->(' . $value_var . '),'
454 . ' type => ' . $type_var_name . ','
455 . ' value => ' . $value_var . ' )';
456 #>>>
457}
458
459# This exists for the benefit of Moo
460sub coercion_sub {
461 my $self = shift;
462
463 if ( defined &Sub::Quote::quote_sub
464 && all { $_->can_be_inlined } $self->coercions ) {
465
466 my $inline = q{};
467 my %env;
468
469 for my $coercion ( $self->coercions ) {
470 $inline .= sprintf(
471 '$_[0] = %s if %s;' . "\n",
472 $coercion->inline_coercion('$_[0]'),
473 $coercion->from->inline_check('$_[0]')
474 );
475
476 %env = (
477 %env,
478 %{ $coercion->inline_environment },
479 %{ $coercion->from->inline_environment },
480 );
481 }
482
483 $inline .= sprintf( "%s;\n", '$_[0]' );
484
485 return Sub::Quote::quote_sub( $inline, \%env );
486 }
487 else {
488 return sub { $self->coerce_value(shift) };
489 }
490}
491
492sub _build_ancestors {
493 my $self = shift;
494
495 my @parents;
496
497 my $type = $self;
498 while ( $type = $type->parent ) {
499 push @parents, $type;
500 }
501
502 return \@parents;
503
504}
505
506sub _build_description {
507 my $self = shift;
508
509 my $desc
510 = $self->is_anon ? 'anonymous type' : 'type named ' . $self->name;
511
512 $desc .= q{ } . $self->declared_at->description;
513
514 return $desc;
515}
516
517sub _build_coercions { {} }
518
519## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
520sub _clone_coercions {
521 my $self = shift;
522
523 my $coercions = $self->_coercions;
524 my %clones;
525
526 for my $name ( keys %{$coercions} ) {
527 my $coercion = $coercions->{$name};
528 $clones{$name} = $coercion->clone_with_new_to($self);
529 }
530
531 return \%clones;
532}
533## use critic
534
535sub _stringify {
536 my $self = shift;
537
538 return $self->name unless $self->is_anon;
539
540 return sprintf( '__ANON__(%s)', $self->parent . q{} );
541}
542
543sub _build_signature {
544 my $self = shift;
545
546 # This assumes that when a type is cloned, the underlying constraint or
547 # generator sub is copied by _reference_, so it has the same memory
548 # address and stringifies to the same value. XXX - will this break under
549 # threads?
550 return join "\n",
551 ( $self->_has_parent ? $self->parent->_signature : () ),
552 (
553 defined $self->_constraint
554 ? $self->_constraint
555 : $self->_inline_generator
556 );
557}
558
559# Moose compatibility methods - these exist as a temporary hack to make Specio
560# work with Moose.
561
562sub has_coercion {
563 shift->has_coercions;
564}
565
566## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
567sub _inline_check {
568 shift->inline_check(@_);
569}
570
571sub _compiled_type_constraint {
572 shift->_optimized_constraint;
573}
574## use critic;
575
576# This class implements the methods that Moose expects from coercions as well.
577sub coercion {
578 return shift;
579}
580
581## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
582sub _compiled_type_coercion {
583 my $self = shift;
584
585 return sub {
586 return $self->coerce_value(shift);
587 };
588}
589## use critic
590
591sub has_message {
592 1;
593}
594
595sub message {
596 shift->_message_generator;
597}
598
599sub get_message {
600 my $self = shift;
601 my $value = shift;
602
603 return $self->_message_generator->( $self, $value );
604}
605
606sub check {
607 shift->value_is_valid(@_);
608}
609
610sub coerce {
611 shift->coerce_value(@_);
612}
613
6141;
615
616# ABSTRACT: The interface all type constraints should provide
617
618__END__