line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# INTERNAL MODULE: a parameter within a Type::Params::Signature. |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Type::Params::Parameter; |
4
|
|
|
|
|
|
|
|
5
|
52
|
|
|
52
|
|
1295
|
use 5.008001; |
|
52
|
|
|
|
|
212
|
|
6
|
52
|
|
|
52
|
|
306
|
use strict; |
|
52
|
|
|
|
|
117
|
|
|
52
|
|
|
|
|
1205
|
|
7
|
52
|
|
|
52
|
|
314
|
use warnings; |
|
52
|
|
|
|
|
122
|
|
|
52
|
|
|
|
|
2610
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
BEGIN { |
10
|
52
|
50
|
|
52
|
|
2053
|
if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } |
|
0
|
|
|
|
|
0
|
|
11
|
|
|
|
|
|
|
} |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
BEGIN { |
14
|
52
|
|
|
52
|
|
183
|
$Type::Params::Parameter::AUTHORITY = 'cpan:TOBYINK'; |
15
|
52
|
|
|
|
|
1790
|
$Type::Params::Parameter::VERSION = '2.004000'; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$Type::Params::Parameter::VERSION =~ tr/_//d; |
19
|
|
|
|
|
|
|
|
20
|
52
|
|
|
52
|
|
322
|
use Types::Standard qw( -is -types ); |
|
52
|
|
|
|
|
129
|
|
|
52
|
|
|
|
|
428
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _croak { |
23
|
1
|
|
|
1
|
|
7
|
require Carp; |
24
|
1
|
|
|
|
|
206
|
Carp::croak( pop ); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
28
|
715
|
|
|
715
|
0
|
1202
|
my $class = shift; |
29
|
|
|
|
|
|
|
|
30
|
715
|
50
|
|
|
|
2338
|
my %self = @_ == 1 ? %{$_[0]} : @_; |
|
0
|
|
|
|
|
0
|
|
31
|
715
|
|
100
|
|
|
3306
|
$self{alias} ||= []; |
32
|
715
|
100
|
66
|
|
|
2863
|
if ( defined $self{alias} and not ref $self{alias} ) { |
33
|
7
|
|
|
|
|
27
|
$self{alias} = [ $self{alias} ]; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
715
|
|
|
|
|
2031
|
bless \%self, $class; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
3
|
|
|
3
|
0
|
12
|
sub name { $_[0]{name} } sub has_name { exists $_[0]{name} } |
|
1580
|
|
|
1580
|
0
|
7042
|
|
40
|
3
|
|
|
3
|
0
|
12
|
sub type { $_[0]{type} } sub has_type { exists $_[0]{type} } |
|
2308
|
|
|
2308
|
0
|
6507
|
|
41
|
17
|
|
|
17
|
0
|
30
|
sub default { $_[0]{default} } sub has_default { exists $_[0]{default} } |
|
1608
|
|
|
1608
|
0
|
5636
|
|
42
|
8
|
|
|
8
|
0
|
63
|
sub alias { $_[0]{alias} } sub has_alias { @{ $_[0]{alias} } } |
|
350
|
|
|
350
|
0
|
579
|
|
|
350
|
|
|
|
|
1309
|
|
43
|
699
|
|
|
699
|
0
|
2515
|
sub strictness { $_[0]{strictness} } sub has_strictness { exists $_[0]{strictness} } |
|
1
|
|
|
1
|
0
|
3
|
|
44
|
|
|
|
|
|
|
|
45
|
851
|
|
|
851
|
0
|
2178
|
sub should_clone { $_[0]{clone} } |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub coerce { |
48
|
|
|
|
|
|
|
exists( $_[0]{coerce} ) |
49
|
|
|
|
|
|
|
? $_[0]{coerce} |
50
|
142
|
50
|
|
142
|
0
|
465
|
: ( $_[0]{coerce} = $_[0]->type->has_coercion ) |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub optional { |
54
|
|
|
|
|
|
|
exists( $_[0]{optional} ) |
55
|
|
|
|
|
|
|
? $_[0]{optional} |
56
|
1963
|
100
|
|
1963
|
0
|
5303
|
: do { |
57
|
|
|
|
|
|
|
$_[0]{optional} = $_[0]->has_default || grep( |
58
|
|
|
|
|
|
|
$_->{uniq} == Optional->{uniq}, |
59
|
688
|
|
100
|
|
|
1523
|
$_[0]->type->parents, |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub getter { |
65
|
|
|
|
|
|
|
exists( $_[0]{getter} ) |
66
|
|
|
|
|
|
|
? $_[0]{getter} |
67
|
|
|
|
|
|
|
: ( $_[0]{getter} = $_[0]{name} ) |
68
|
126
|
100
|
|
126
|
0
|
461
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub predicate { |
71
|
|
|
|
|
|
|
exists( $_[0]{predicate} ) |
72
|
|
|
|
|
|
|
? $_[0]{predicate} |
73
|
126
|
100
|
|
126
|
0
|
437
|
: ( $_[0]{predicate} = ( $_[0]->optional ? 'has_' . $_[0]{name} : undef ) ) |
|
|
100
|
|
|
|
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub might_supply_new_value { |
77
|
152
|
100
|
100
|
152
|
0
|
417
|
$_[0]->has_default or $_[0]->coerce or $_[0]->should_clone; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _code_for_default { |
81
|
17
|
|
|
17
|
|
39
|
my ( $self, $signature, $coderef ) = @_; |
82
|
17
|
|
|
|
|
42
|
my $default = $self->default; |
83
|
|
|
|
|
|
|
|
84
|
17
|
100
|
|
|
|
79
|
if ( is_CodeRef $default ) { |
85
|
|
|
|
|
|
|
my $default_varname = $coderef->add_variable( |
86
|
|
|
|
|
|
|
'$default_for_' . $self->{vartail}, |
87
|
4
|
|
|
|
|
26
|
\$default, |
88
|
|
|
|
|
|
|
); |
89
|
4
|
|
|
|
|
14
|
return sprintf( '%s->( %s )', $default_varname, $signature->method_invocant ); |
90
|
|
|
|
|
|
|
} |
91
|
13
|
100
|
|
|
|
45
|
if ( is_Undef $default ) { |
92
|
2
|
|
|
|
|
10
|
return 'undef'; |
93
|
|
|
|
|
|
|
} |
94
|
11
|
100
|
|
|
|
33
|
if ( is_Str $default ) { |
95
|
5
|
|
|
|
|
40
|
return B::perlstring( $default ); |
96
|
|
|
|
|
|
|
} |
97
|
6
|
100
|
|
|
|
16
|
if ( is_HashRef $default ) { |
98
|
2
|
|
|
|
|
13
|
return '{}'; |
99
|
|
|
|
|
|
|
} |
100
|
4
|
100
|
|
|
|
15
|
if ( is_ArrayRef $default ) { |
101
|
2
|
|
|
|
|
13
|
return '[]'; |
102
|
|
|
|
|
|
|
} |
103
|
2
|
100
|
|
|
|
9
|
if ( is_ScalarRef $default ) { |
104
|
1
|
|
|
|
|
5
|
return $$default; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
1
|
|
|
|
|
5
|
$self->_croak( 'Default expected to be undef, string, coderef, or empty arrayref/hashref' ); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
sub _maybe_clone { |
111
|
19
|
|
|
19
|
|
43
|
my ( $self, $varname ) = @_; |
112
|
|
|
|
|
|
|
|
113
|
19
|
100
|
|
|
|
53
|
if ( $self->should_clone ) { |
114
|
2
|
|
|
|
|
14
|
return sprintf( 'Storable::dclone( %s )', $varname ); |
115
|
|
|
|
|
|
|
} |
116
|
17
|
|
|
|
|
53
|
return $varname; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _make_code { |
120
|
699
|
|
|
699
|
|
3910
|
my ( $self, %args ) = ( shift, @_ ); |
121
|
|
|
|
|
|
|
|
122
|
699
|
|
100
|
|
|
2763
|
my $type = $args{type} || 'arg'; |
123
|
699
|
|
|
|
|
1306
|
my $signature = $args{signature}; |
124
|
699
|
|
|
|
|
1149
|
my $coderef = $args{coderef}; |
125
|
699
|
|
|
|
|
1140
|
my $varname = $args{input_slot}; |
126
|
699
|
|
|
|
|
1211
|
my $index = $args{index}; |
127
|
699
|
|
|
|
|
1559
|
my $constraint = $self->type; |
128
|
699
|
|
|
|
|
1613
|
my $is_optional = $self->optional; |
129
|
|
|
|
|
|
|
my $really_optional = |
130
|
|
|
|
|
|
|
$is_optional |
131
|
|
|
|
|
|
|
&& $constraint->parent |
132
|
|
|
|
|
|
|
&& $constraint->parent->{uniq} eq Optional->{uniq} |
133
|
699
|
|
66
|
|
|
6668
|
&& $constraint->type_parameter; |
134
|
|
|
|
|
|
|
|
135
|
699
|
|
|
|
|
1438
|
my $strictness; |
136
|
699
|
100
|
|
|
|
1548
|
if ( $self->has_strictness ) { |
|
|
100
|
|
|
|
|
|
137
|
1
|
|
|
|
|
5
|
$strictness = \ $self->strictness; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
elsif ( $signature->has_strictness ) { |
140
|
9
|
|
|
|
|
32
|
$strictness = \ $signature->strictness; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
699
|
|
|
|
|
1411
|
my ( $vartail, $exists_check ); |
144
|
699
|
100
|
|
|
|
1514
|
if ( $args{is_named} ) { |
145
|
350
|
|
|
|
|
623
|
my $bit = $args{key}; |
146
|
350
|
50
|
|
|
|
917
|
$bit =~ s/([_\W])/$1 eq '_' ? '__' : sprintf('_%x', ord($1))/ge; |
|
2
|
|
|
|
|
10
|
|
147
|
350
|
|
|
|
|
774
|
$vartail = $type . '_' . $bit; |
148
|
350
|
|
|
|
|
1009
|
$exists_check = sprintf 'exists( %s )', $args{input_slot}; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
else { |
151
|
349
|
|
100
|
|
|
1764
|
( my $input_count_varname = $args{input_var} || '' ) =~ s/\@/\$\#/; |
152
|
349
|
|
|
|
|
931
|
$vartail = $type . '_' . $index; |
153
|
349
|
|
|
|
|
1127
|
$exists_check = sprintf '%s >= %d', $input_count_varname, $index; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
699
|
|
|
|
|
1197
|
my $block_needs_ending = 0; |
157
|
699
|
|
|
|
|
1557
|
my $needs_clone = $self->should_clone; |
158
|
699
|
|
|
|
|
1085
|
my $in_big_optional_block = 0; |
159
|
|
|
|
|
|
|
|
160
|
699
|
100
|
66
|
|
|
1756
|
if ( $needs_clone and not $signature->{loaded_Storable} ) { |
161
|
2
|
|
|
|
|
7
|
$coderef->add_line( 'use Storable ();' ); |
162
|
2
|
|
|
|
|
5
|
$coderef->add_gap; |
163
|
2
|
|
|
|
|
5
|
$signature->{loaded_Storable} = 1; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
167
|
|
|
|
|
|
|
'# Parameter %s (type: %s)', |
168
|
|
|
|
|
|
|
$self->name || $args{input_slot}, |
169
|
699
|
|
66
|
|
|
1595
|
$constraint->display_name, |
170
|
|
|
|
|
|
|
) ); |
171
|
|
|
|
|
|
|
|
172
|
699
|
100
|
100
|
|
|
2469
|
if ( $args{is_named} and $self->has_alias ) { |
173
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
174
|
|
|
|
|
|
|
'for my $alias ( %s ) {', |
175
|
8
|
|
|
|
|
28
|
join( q{, }, map B::perlstring($_), @{ $self->alias } ), |
|
8
|
|
|
|
|
29
|
|
176
|
|
|
|
|
|
|
) ); |
177
|
8
|
|
|
|
|
39
|
$coderef->increase_indent; |
178
|
8
|
|
|
|
|
24
|
$coderef->add_line( 'exists $in{$alias} or next;' ); |
179
|
8
|
|
|
|
|
34
|
$coderef->add_line( sprintf( |
180
|
|
|
|
|
|
|
'if ( %s ) {', |
181
|
|
|
|
|
|
|
$exists_check, |
182
|
|
|
|
|
|
|
) ); |
183
|
8
|
|
|
|
|
32
|
$coderef->increase_indent; |
184
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
185
|
|
|
|
|
|
|
'%s;', |
186
|
|
|
|
|
|
|
$signature->_make_general_fail( |
187
|
|
|
|
|
|
|
coderef => $coderef, |
188
|
8
|
|
33
|
|
|
28
|
message => q{sprintf( 'Superfluous alias "%s" for argument "%s"', $alias, } . B::perlstring( $self->name || $args{input_slot} ) . q{ )}, |
189
|
|
|
|
|
|
|
), |
190
|
|
|
|
|
|
|
) ); |
191
|
8
|
|
|
|
|
35
|
$coderef->decrease_indent; |
192
|
8
|
|
|
|
|
26
|
$coderef->add_line( '}' ); |
193
|
8
|
|
|
|
|
29
|
$coderef->add_line( 'else {' ); |
194
|
8
|
|
|
|
|
26
|
$coderef->increase_indent; |
195
|
8
|
|
|
|
|
34
|
$coderef->add_line( sprintf( |
196
|
|
|
|
|
|
|
'%s = delete( $in{$alias} );', |
197
|
|
|
|
|
|
|
$varname, |
198
|
|
|
|
|
|
|
) ); |
199
|
8
|
|
|
|
|
26
|
$coderef->decrease_indent; |
200
|
8
|
|
|
|
|
27
|
$coderef->add_line( '}' ); |
201
|
8
|
|
|
|
|
20
|
$coderef->decrease_indent; |
202
|
8
|
|
|
|
|
17
|
$coderef->add_line( '}' ); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
699
|
100
|
|
|
|
1627
|
if ( $self->has_default ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
206
|
17
|
|
|
|
|
39
|
$self->{vartail} = $vartail; # hack |
207
|
17
|
|
|
|
|
44
|
$coderef->add_line( sprintf( |
208
|
|
|
|
|
|
|
'$dtmp = %s ? %s : %s;', |
209
|
|
|
|
|
|
|
$exists_check, |
210
|
|
|
|
|
|
|
$self->_maybe_clone( $varname ), |
211
|
|
|
|
|
|
|
$self->_code_for_default( $signature, $coderef ), |
212
|
|
|
|
|
|
|
) ); |
213
|
16
|
|
|
|
|
30
|
$varname = '$dtmp'; |
214
|
16
|
|
|
|
|
27
|
$needs_clone = 0; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
elsif ( $self->optional ) { |
217
|
99
|
100
|
|
|
|
244
|
if ( $args{is_named} ) { |
218
|
80
|
|
|
|
|
347
|
$coderef->add_line( sprintf( |
219
|
|
|
|
|
|
|
'if ( %s ) {', |
220
|
|
|
|
|
|
|
$exists_check, |
221
|
|
|
|
|
|
|
) ); |
222
|
80
|
|
|
|
|
168
|
$coderef->{indent} .= "\t"; |
223
|
80
|
|
|
|
|
157
|
++$block_needs_ending; |
224
|
80
|
|
|
|
|
162
|
++$in_big_optional_block; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
else { |
227
|
19
|
|
|
|
|
56
|
$coderef->add_line( sprintf( |
228
|
|
|
|
|
|
|
"%s\n\tor %s;", |
229
|
|
|
|
|
|
|
$exists_check, |
230
|
|
|
|
|
|
|
$signature->_make_return_expression( is_early => 1 ), |
231
|
|
|
|
|
|
|
) ); |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
elsif ( $args{is_named} ) { |
235
|
264
|
|
|
|
|
1141
|
$coderef->add_line( sprintf( |
236
|
|
|
|
|
|
|
"%s\n\tor %s;", |
237
|
|
|
|
|
|
|
$exists_check, |
238
|
|
|
|
|
|
|
$signature->_make_general_fail( |
239
|
|
|
|
|
|
|
coderef => $coderef, |
240
|
|
|
|
|
|
|
message => "'Missing required parameter: $args{key}'", |
241
|
|
|
|
|
|
|
), |
242
|
|
|
|
|
|
|
) ); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
698
|
100
|
|
|
|
1736
|
if ( $needs_clone ) { |
246
|
2
|
|
|
|
|
6
|
$coderef->add_line( sprintf( |
247
|
|
|
|
|
|
|
'$dtmp = %s;', |
248
|
|
|
|
|
|
|
$self->_maybe_clone( $varname ), |
249
|
|
|
|
|
|
|
) ); |
250
|
2
|
|
|
|
|
5
|
$varname = '$dtmp'; |
251
|
2
|
|
|
|
|
4
|
$needs_clone = 0; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
698
|
100
|
100
|
|
|
2336
|
if ( $constraint->has_coercion and $constraint->coercion->can_be_inlined ) { |
|
|
100
|
|
|
|
|
|
255
|
84
|
100
|
|
|
|
383
|
$coderef->add_line( sprintf( |
256
|
|
|
|
|
|
|
'$tmp%s = %s;', |
257
|
|
|
|
|
|
|
( $is_optional ? '{x}' : '' ), |
258
|
|
|
|
|
|
|
$constraint->coercion->inline_coercion( $varname ) |
259
|
|
|
|
|
|
|
) ); |
260
|
84
|
100
|
|
|
|
335
|
$varname = '$tmp' . ( $is_optional ? '{x}' : '' ); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
elsif ( $constraint->has_coercion ) { |
263
|
83
|
|
|
|
|
344
|
my $coercion_varname = $coderef->add_variable( |
264
|
|
|
|
|
|
|
'$coercion_for_' . $vartail, |
265
|
|
|
|
|
|
|
\ $constraint->coercion->compiled_coercion, |
266
|
|
|
|
|
|
|
); |
267
|
83
|
100
|
|
|
|
613
|
$coderef->add_line( sprintf( |
268
|
|
|
|
|
|
|
'$tmp%s = &%s( %s );', |
269
|
|
|
|
|
|
|
( $is_optional ? '{x}' : '' ), |
270
|
|
|
|
|
|
|
$coercion_varname, |
271
|
|
|
|
|
|
|
$varname, |
272
|
|
|
|
|
|
|
) ); |
273
|
83
|
100
|
|
|
|
263
|
$varname = '$tmp' . ( $is_optional ? '{x}' : '' ); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
698
|
|
|
|
|
2631
|
undef $Type::Tiny::ALL_TYPES{ $constraint->{uniq} }; |
277
|
698
|
|
|
|
|
1465
|
$Type::Tiny::ALL_TYPES{ $constraint->{uniq} } = $constraint; |
278
|
|
|
|
|
|
|
|
279
|
698
|
|
|
|
|
1185
|
my $strictness_test = ''; |
280
|
698
|
100
|
100
|
|
|
3016
|
if ( $strictness and $$strictness eq 1 ) { |
|
|
100
|
100
|
|
|
|
|
281
|
3
|
|
|
|
|
6
|
$strictness_test = ''; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
elsif ( $strictness and $$strictness ) { |
284
|
5
|
|
|
|
|
18
|
$strictness_test = sprintf "( not %s )\n\tor ", $$strictness; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
698
|
100
|
100
|
|
|
3153
|
if ( $strictness and not $$strictness ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
288
|
2
|
|
|
|
|
8
|
$coderef->add_line( '1; # ... nothing to do' ); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
elsif ( $constraint->{uniq} == Any->{uniq} ) { |
291
|
13
|
|
|
|
|
75
|
$coderef->add_line( '1; # ... nothing to do' ); |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
elsif ( $constraint->can_be_inlined ) { |
294
|
|
|
|
|
|
|
$coderef->add_line( $strictness_test . sprintf( |
295
|
|
|
|
|
|
|
"%s\n\tor %s;", |
296
|
|
|
|
|
|
|
( $really_optional or $constraint )->inline_check( $varname ), |
297
|
|
|
|
|
|
|
$signature->_make_constraint_fail( |
298
|
|
|
|
|
|
|
coderef => $coderef, |
299
|
|
|
|
|
|
|
parameter => $self, |
300
|
|
|
|
|
|
|
constraint => $constraint, |
301
|
|
|
|
|
|
|
varname => $varname, |
302
|
|
|
|
|
|
|
display_var => $args{display_var}, |
303
|
622
|
|
66
|
|
|
2562
|
), |
304
|
|
|
|
|
|
|
) ); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else { |
307
|
61
|
|
66
|
|
|
312
|
my $compiled_check_varname = $coderef->add_variable( |
308
|
|
|
|
|
|
|
'$check_for_' . $vartail, |
309
|
|
|
|
|
|
|
\ ( ( $really_optional or $constraint )->compiled_check ), |
310
|
|
|
|
|
|
|
); |
311
|
|
|
|
|
|
|
$coderef->add_line( $strictness_test . sprintf( |
312
|
|
|
|
|
|
|
"&%s( %s )\n\tor %s;", |
313
|
|
|
|
|
|
|
$compiled_check_varname, |
314
|
|
|
|
|
|
|
$varname, |
315
|
|
|
|
|
|
|
$signature->_make_constraint_fail( |
316
|
|
|
|
|
|
|
coderef => $coderef, |
317
|
|
|
|
|
|
|
parameter => $self, |
318
|
|
|
|
|
|
|
constraint => $constraint, |
319
|
|
|
|
|
|
|
varname => $varname, |
320
|
|
|
|
|
|
|
display_var => $args{display_var}, |
321
|
61
|
|
|
|
|
293
|
), |
322
|
|
|
|
|
|
|
) ); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
698
|
100
|
100
|
|
|
3682
|
if ( $args{output_var} ) { |
|
|
100
|
|
|
|
|
|
326
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
327
|
|
|
|
|
|
|
'push( %s, %s );', |
328
|
|
|
|
|
|
|
$args{output_var}, |
329
|
104
|
|
|
|
|
423
|
$varname, |
330
|
|
|
|
|
|
|
) ); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
elsif ( $args{output_slot} and $args{output_slot} ne $varname ) { |
333
|
390
|
100
|
100
|
|
|
1849
|
if ( !$in_big_optional_block and $varname =~ /\{/ ) { |
334
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
335
|
|
|
|
|
|
|
'%s = %s if exists( %s );', |
336
|
|
|
|
|
|
|
$args{output_slot}, |
337
|
204
|
|
|
|
|
879
|
$varname, |
338
|
|
|
|
|
|
|
$varname, |
339
|
|
|
|
|
|
|
) ); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
else { |
342
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
343
|
|
|
|
|
|
|
'%s = %s;', |
344
|
|
|
|
|
|
|
$args{output_slot}, |
345
|
186
|
|
|
|
|
788
|
$varname, |
346
|
|
|
|
|
|
|
) ); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
698
|
100
|
|
|
|
1769
|
if ( $args{is_named} ) { |
351
|
|
|
|
|
|
|
$coderef->add_line( sprintf( |
352
|
|
|
|
|
|
|
'delete( %s );', |
353
|
|
|
|
|
|
|
$args{input_slot}, |
354
|
350
|
|
|
|
|
1182
|
) ); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
698
|
100
|
|
|
|
1663
|
if ( $block_needs_ending ) { |
358
|
80
|
|
|
|
|
421
|
$coderef->{indent} =~ s/\s$//; |
359
|
80
|
|
|
|
|
291
|
$coderef->add_line( '}' ); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
698
|
|
|
|
|
2125
|
$coderef->add_gap; |
363
|
|
|
|
|
|
|
|
364
|
698
|
|
|
|
|
3117
|
$self; |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
1; |