line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
# ^^^^^^ !!!!!! ^^^^^^^ |
3
|
|
|
|
|
|
|
# Yes, this module really is supposed to have a #! |
4
|
|
|
|
|
|
|
# line and be an executable script. See the end of the file |
5
|
|
|
|
|
|
|
# for why! |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package Assert::Conditional; |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
412875
|
use v5.12; |
|
3
|
|
|
|
|
26
|
|
10
|
3
|
|
|
3
|
|
1408
|
use utf8; |
|
3
|
|
|
|
|
32
|
|
|
3
|
|
|
|
|
17
|
|
11
|
3
|
|
|
3
|
|
86
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
68
|
|
12
|
3
|
|
|
3
|
|
15
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
99
|
|
13
|
|
|
|
|
|
|
|
14
|
3
|
|
|
3
|
|
1411
|
use version 0.77; |
|
3
|
|
|
|
|
5993
|
|
|
3
|
|
|
|
|
24
|
|
15
|
|
|
|
|
|
|
our $VERSION = version->declare("0.010"); |
16
|
|
|
|
|
|
|
|
17
|
3
|
|
|
3
|
|
1799
|
use parent "Exporter::ConditionalSubs"; # inherits from Exporter |
|
3
|
|
|
|
|
773
|
|
|
3
|
|
|
|
|
18
|
|
18
|
|
|
|
|
|
|
|
19
|
3
|
|
|
3
|
|
6592
|
use namespace::autoclean; |
|
3
|
|
|
|
|
54703
|
|
|
3
|
|
|
|
|
11
|
|
20
|
|
|
|
|
|
|
|
21
|
3
|
|
|
3
|
|
1963
|
use Attribute::Handlers; |
|
3
|
|
|
|
|
14957
|
|
|
3
|
|
|
|
|
26
|
|
22
|
3
|
|
|
3
|
|
1896
|
use Assert::Conditional::Utils ":all"; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
1582
|
|
23
|
3
|
|
|
3
|
|
24
|
use Carp qw(carp croak cluck confess); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
219
|
|
24
|
3
|
|
|
3
|
|
20
|
use POSIX ":sys_wait_h"; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
25
|
|
25
|
|
|
|
|
|
|
|
26
|
3
|
|
|
|
|
211
|
use Scalar::Util qw{ |
27
|
|
|
|
|
|
|
blessed |
28
|
|
|
|
|
|
|
looks_like_number |
29
|
|
|
|
|
|
|
openhandle |
30
|
|
|
|
|
|
|
refaddr |
31
|
|
|
|
|
|
|
reftype |
32
|
3
|
|
|
3
|
|
4680
|
}; |
|
3
|
|
|
|
|
6
|
|
33
|
|
|
|
|
|
|
|
34
|
3
|
|
|
|
|
501
|
use Unicode::Normalize qw{ |
35
|
|
|
|
|
|
|
NFC checkNFC |
36
|
|
|
|
|
|
|
NFD checkNFD |
37
|
|
|
|
|
|
|
NFKC checkNFKC |
38
|
|
|
|
|
|
|
NFKD checkNFKD |
39
|
3
|
|
|
3
|
|
1742
|
}; |
|
3
|
|
|
|
|
6240
|
|
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
# But these are private internal functions that we |
42
|
|
|
|
|
|
|
# choose not to expose even if fully qualified, |
43
|
|
|
|
|
|
|
# and so declaring them here in front of the |
44
|
|
|
|
|
|
|
# imminent namespace::clean will make sure of that. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub _coredump_message ( ;$ ) ; |
47
|
|
|
|
|
|
|
sub _get_invocant_type ( $ ) ; |
48
|
|
|
|
|
|
|
sub _promote_to_arrayref ( $ ) ; |
49
|
|
|
|
|
|
|
sub _promote_to_hashref ( $ ) ; |
50
|
|
|
|
|
|
|
sub _promote_to_typeref ( $$ ) ; |
51
|
|
|
|
|
|
|
sub _run_code_test ( $$ ) ; |
52
|
|
|
|
|
|
|
sub _signum_message ( $ ) ; |
53
|
|
|
|
|
|
|
sub _WIFCORED ( ;$ ) ; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# Need to be able to measure coverage with Devel::Cover |
56
|
|
|
|
|
|
|
# of stuff we would normally get rid of. |
57
|
3
|
|
|
3
|
|
2060
|
use if !$ENV{HARNESS_ACTIVE}, "namespace::clean"; |
|
3
|
|
|
|
|
48
|
|
|
3
|
|
|
|
|
22
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
####################################################################### |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# First declare our Exporter vars: |
62
|
|
|
|
|
|
|
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# Then thanks to this little guy.... |
65
|
|
|
|
|
|
|
sub Assert; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Now those have by now all been fully populated *during compilation*, |
68
|
|
|
|
|
|
|
# so it only remains to re-collate them into pleasant alphabetic order: |
69
|
|
|
|
|
|
|
@$_ = uca_sort @$_ for \@EXPORT_OK, values %EXPORT_TAGS; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub assert_ainta ( $@ ) ; |
72
|
|
|
|
|
|
|
sub assert_alnum ( $ ) ; |
73
|
|
|
|
|
|
|
sub assert_alphabetic ( $ ) ; |
74
|
|
|
|
|
|
|
sub assert_anyref ( $ ) ; |
75
|
|
|
|
|
|
|
sub assert_argc ( ;$ ) ; |
76
|
|
|
|
|
|
|
sub assert_argc_max ( $ ) ; |
77
|
|
|
|
|
|
|
sub assert_argc_min ( $ ) ; |
78
|
|
|
|
|
|
|
sub assert_argc_minmax ( $$ ) ; |
79
|
|
|
|
|
|
|
sub assert_array_length ( \@ ;$ ) ; |
80
|
|
|
|
|
|
|
sub assert_array_length_max ( \@ $ ) ; |
81
|
|
|
|
|
|
|
sub assert_array_length_min ( \@ $ ) ; |
82
|
|
|
|
|
|
|
sub assert_array_length_minmax ( \@ $$ ) ; |
83
|
|
|
|
|
|
|
sub assert_array_nonempty ( \@ ) ; |
84
|
|
|
|
|
|
|
sub assert_arrayref ( $ ) ; |
85
|
|
|
|
|
|
|
sub assert_arrayref_nonempty ( $ ) ; |
86
|
|
|
|
|
|
|
sub assert_ascii ( $ ) ; |
87
|
|
|
|
|
|
|
sub assert_ascii_ident ( $ ) ; |
88
|
|
|
|
|
|
|
sub assert_astral ( $ ) ; |
89
|
|
|
|
|
|
|
sub assert_blank ( $ ) ; |
90
|
|
|
|
|
|
|
sub assert_bmp ( $ ) ; |
91
|
|
|
|
|
|
|
sub assert_box_number ( $ ) ; |
92
|
|
|
|
|
|
|
sub assert_bytes ( $ ) ; |
93
|
|
|
|
|
|
|
sub assert_can ( $@ ) ; |
94
|
|
|
|
|
|
|
sub assert_cant ( $@ ) ; |
95
|
|
|
|
|
|
|
sub assert_class_ainta ( $@ ) ; |
96
|
|
|
|
|
|
|
sub assert_class_can ( $@ ) ; |
97
|
|
|
|
|
|
|
sub assert_class_cant ( $@ ) ; |
98
|
|
|
|
|
|
|
sub assert_class_isa ( $@ ) ; |
99
|
|
|
|
|
|
|
sub assert_class_method ( ) ; |
100
|
|
|
|
|
|
|
sub assert_coderef ( $ ) ; |
101
|
|
|
|
|
|
|
sub assert_defined ( $ ) ; |
102
|
|
|
|
|
|
|
sub assert_defined_value ( $ ) ; |
103
|
|
|
|
|
|
|
sub assert_defined_variable ( \$ ) ; |
104
|
|
|
|
|
|
|
sub assert_digits ( $ ) ; |
105
|
|
|
|
|
|
|
sub assert_directory ( $ ) ; |
106
|
|
|
|
|
|
|
sub assert_does ( $@ ) ; |
107
|
|
|
|
|
|
|
sub assert_doesnt ( $@ ) ; |
108
|
|
|
|
|
|
|
sub assert_dumped_core ( ;$ ) ; |
109
|
|
|
|
|
|
|
sub assert_empty ( $ ) ; |
110
|
|
|
|
|
|
|
sub assert_eq ( $$ ) ; |
111
|
|
|
|
|
|
|
sub assert_eq_letters ( $$ ) ; |
112
|
|
|
|
|
|
|
sub assert_even_number ( $ ) ; |
113
|
|
|
|
|
|
|
sub assert_exited ( ;$ ) ; |
114
|
|
|
|
|
|
|
sub assert_false ( $ ) ; |
115
|
|
|
|
|
|
|
sub assert_fractional ( $ ) ; |
116
|
|
|
|
|
|
|
sub assert_full_perl_ident ( $ ) ; |
117
|
|
|
|
|
|
|
sub assert_globref ( $ ) ; |
118
|
|
|
|
|
|
|
sub assert_happy_code ( & ) ; |
119
|
|
|
|
|
|
|
sub assert_happy_exit ( ;$ ) ; |
120
|
|
|
|
|
|
|
sub assert_hash_keys ( \% @ ) ; |
121
|
|
|
|
|
|
|
sub assert_hash_keys_allowed ( \% @ ) ; |
122
|
|
|
|
|
|
|
sub assert_hash_keys_allowed_and_required ( \% $ $ ) ; |
123
|
|
|
|
|
|
|
sub assert_hash_keys_required ( \% @ ) ; |
124
|
|
|
|
|
|
|
sub assert_hash_keys_required_and_allowed ( \% $ $ ) ; |
125
|
|
|
|
|
|
|
sub assert_hash_nonempty ( \% ) ; |
126
|
|
|
|
|
|
|
sub assert_hashref ( $ ) ; |
127
|
|
|
|
|
|
|
sub assert_hashref_keys ( $@ ) ; |
128
|
|
|
|
|
|
|
sub assert_hashref_keys_allowed ( $@ ) ; |
129
|
|
|
|
|
|
|
sub assert_hashref_keys_allowed_and_required ( $$$ ) ; |
130
|
|
|
|
|
|
|
sub assert_hashref_keys_required ( $@ ) ; |
131
|
|
|
|
|
|
|
sub assert_hashref_keys_required_and_allowed ( $$$ ) ; |
132
|
|
|
|
|
|
|
sub assert_hashref_nonempty ( $ ) ; |
133
|
|
|
|
|
|
|
sub assert_hex_number ( $ ) ; |
134
|
|
|
|
|
|
|
sub assert_in_list ( $@ ) ; |
135
|
|
|
|
|
|
|
sub assert_in_numeric_range ( $$$ ) ; |
136
|
|
|
|
|
|
|
sub assert_integer ( $ ) ; |
137
|
|
|
|
|
|
|
sub assert_ioref ( $ ) ; |
138
|
|
|
|
|
|
|
sub assert_is ( $$ ) ; |
139
|
|
|
|
|
|
|
sub assert_isa ( $@ ) ; |
140
|
|
|
|
|
|
|
sub assert_isnt ( $$ ) ; |
141
|
|
|
|
|
|
|
sub assert_keys ( \[%$] @ ) ; |
142
|
|
|
|
|
|
|
sub assert_known_package ( $ ) ; |
143
|
|
|
|
|
|
|
sub assert_latin1 ( $ ) ; |
144
|
|
|
|
|
|
|
sub assert_latinish ( $ ) ; |
145
|
|
|
|
|
|
|
sub assert_legal_exit_status ( ;$ ) ; |
146
|
|
|
|
|
|
|
sub assert_like ( $$ ) ; |
147
|
|
|
|
|
|
|
sub assert_list_context ( ) ; |
148
|
|
|
|
|
|
|
sub assert_list_nonempty ( @ ) ; |
149
|
|
|
|
|
|
|
sub assert_locked ( \[%$] @ ) ; |
150
|
|
|
|
|
|
|
sub assert_lowercased ( $ ) ; |
151
|
|
|
|
|
|
|
sub assert_max_keys ( \[%$] @ ) ; |
152
|
|
|
|
|
|
|
sub assert_method ( ) ; |
153
|
|
|
|
|
|
|
sub assert_min_keys ( \[%$] @ ) ; |
154
|
|
|
|
|
|
|
sub assert_minmax_keys ( \[%$] \[@$] \[@$] ) ; |
155
|
|
|
|
|
|
|
sub assert_multi_line ( $ ) ; |
156
|
|
|
|
|
|
|
sub assert_natural_number ( $ ) ; |
157
|
|
|
|
|
|
|
sub assert_negative ( $ ) ; |
158
|
|
|
|
|
|
|
sub assert_negative_integer ( $ ) ; |
159
|
|
|
|
|
|
|
sub assert_nfc ( $ ) ; |
160
|
|
|
|
|
|
|
sub assert_nfd ( $ ) ; |
161
|
|
|
|
|
|
|
sub assert_nfkc ( $ ) ; |
162
|
|
|
|
|
|
|
sub assert_nfkd ( $ ) ; |
163
|
|
|
|
|
|
|
sub assert_no_coredump ( ;$ ) ; |
164
|
|
|
|
|
|
|
sub assert_nonalphabetic ( $ ) ; |
165
|
|
|
|
|
|
|
sub assert_nonascii ( $ ) ; |
166
|
|
|
|
|
|
|
sub assert_nonastral ( $ ) ; |
167
|
|
|
|
|
|
|
sub assert_nonblank ( $ ) ; |
168
|
|
|
|
|
|
|
sub assert_nonbytes ( $ ) ; |
169
|
|
|
|
|
|
|
sub assert_nonempty ( $ ) ; |
170
|
|
|
|
|
|
|
sub assert_nonlist_context ( ) ; |
171
|
|
|
|
|
|
|
sub assert_nonnegative ( $ ) ; |
172
|
|
|
|
|
|
|
sub assert_nonnegative_integer ( $ ) ; |
173
|
|
|
|
|
|
|
sub assert_nonnumeric ( $ ) ; |
174
|
|
|
|
|
|
|
sub assert_nonobject ( $ ) ; |
175
|
|
|
|
|
|
|
sub assert_nonpositive ( $ ) ; |
176
|
|
|
|
|
|
|
sub assert_nonpositive_integer ( $ ) ; |
177
|
|
|
|
|
|
|
sub assert_nonref ( $ ) ; |
178
|
|
|
|
|
|
|
sub assert_nonvoid_context ( ) ; |
179
|
|
|
|
|
|
|
sub assert_nonzero ( $ ) ; |
180
|
|
|
|
|
|
|
sub assert_not_in_list ( $@ ) ; |
181
|
|
|
|
|
|
|
sub assert_numeric ( $ ) ; |
182
|
|
|
|
|
|
|
sub assert_object ( $ ) ; |
183
|
|
|
|
|
|
|
sub assert_object_ainta ( $@ ) ; |
184
|
|
|
|
|
|
|
sub assert_object_boolifies ( $ ) ; |
185
|
|
|
|
|
|
|
sub assert_object_can ( $@ ) ; |
186
|
|
|
|
|
|
|
sub assert_object_cant ( $@ ) ; |
187
|
|
|
|
|
|
|
sub assert_object_isa ( $@ ) ; |
188
|
|
|
|
|
|
|
sub assert_object_method ( ) ; |
189
|
|
|
|
|
|
|
sub assert_object_nummifies ( $ ) ; |
190
|
|
|
|
|
|
|
sub assert_object_overloads ( $@ ) ; |
191
|
|
|
|
|
|
|
sub assert_object_stringifies ( $ ) ; |
192
|
|
|
|
|
|
|
sub assert_odd_number ( $ ) ; |
193
|
|
|
|
|
|
|
sub assert_open_handle ( $ ) ; |
194
|
|
|
|
|
|
|
sub assert_positive ( $ ) ; |
195
|
|
|
|
|
|
|
sub assert_positive_integer ( $ ) ; |
196
|
|
|
|
|
|
|
sub assert_private_method ( ) ; |
197
|
|
|
|
|
|
|
sub assert_protected_method ( ) ; |
198
|
|
|
|
|
|
|
sub assert_public_method ( ) ; |
199
|
|
|
|
|
|
|
sub assert_qualified_ident ( $ ) ; |
200
|
|
|
|
|
|
|
sub assert_refref ( $ ) ; |
201
|
|
|
|
|
|
|
sub assert_reftype ( $$ ) ; |
202
|
|
|
|
|
|
|
sub assert_regex ( $ ) ; |
203
|
|
|
|
|
|
|
sub assert_regular_file ( $ ) ; |
204
|
|
|
|
|
|
|
sub assert_sad_exit ( ;$ ) ; |
205
|
|
|
|
|
|
|
sub assert_scalar_context ( ) ; |
206
|
|
|
|
|
|
|
sub assert_scalarref ( $ ) ; |
207
|
|
|
|
|
|
|
sub assert_signalled ( ;$ ) ; |
208
|
|
|
|
|
|
|
sub assert_signed_number ( $ ) ; |
209
|
|
|
|
|
|
|
sub assert_simple_perl_ident ( $ ) ; |
210
|
|
|
|
|
|
|
sub assert_single_line ( $ ) ; |
211
|
|
|
|
|
|
|
sub assert_single_paragraph ( $ ) ; |
212
|
|
|
|
|
|
|
sub assert_text_file ( $ ) ; |
213
|
|
|
|
|
|
|
sub assert_tied ( \[$@%*] ) ; |
214
|
|
|
|
|
|
|
sub assert_tied_array ( \@ ) ; |
215
|
|
|
|
|
|
|
sub assert_tied_arrayref ( $ ) ; |
216
|
|
|
|
|
|
|
sub assert_tied_glob ( \* ) ; |
217
|
|
|
|
|
|
|
sub assert_tied_globref ( $ ) ; |
218
|
|
|
|
|
|
|
sub assert_tied_hash ( \% ) ; |
219
|
|
|
|
|
|
|
sub assert_tied_hashref ( $ ) ; |
220
|
|
|
|
|
|
|
sub assert_tied_referent ( $ ) ; |
221
|
|
|
|
|
|
|
sub assert_tied_scalar ( \$ ) ; |
222
|
|
|
|
|
|
|
sub assert_tied_scalarref ( $ ) ; |
223
|
|
|
|
|
|
|
sub assert_true ( $ ) ; |
224
|
|
|
|
|
|
|
sub assert_unblessed_ref ( $ ) ; |
225
|
|
|
|
|
|
|
sub assert_undefined ( $ ) ; |
226
|
|
|
|
|
|
|
sub assert_unhappy_code ( & ) ; |
227
|
|
|
|
|
|
|
sub assert_unicode_ident ( $ ) ; |
228
|
|
|
|
|
|
|
sub assert_unlike ( $$ ) ; |
229
|
|
|
|
|
|
|
sub assert_unlocked ( \[%$] @ ) ; |
230
|
|
|
|
|
|
|
sub assert_unsignalled ( ;$ ) ; |
231
|
|
|
|
|
|
|
sub assert_untied ( \[$@%*] ) ; |
232
|
|
|
|
|
|
|
sub assert_untied_array ( \@ ) ; |
233
|
|
|
|
|
|
|
sub assert_untied_arrayref ( $ ) ; |
234
|
|
|
|
|
|
|
sub assert_untied_glob ( \* ) ; |
235
|
|
|
|
|
|
|
sub assert_untied_globref ( $ ) ; |
236
|
|
|
|
|
|
|
sub assert_untied_hash ( \% ) ; |
237
|
|
|
|
|
|
|
sub assert_untied_hashref ( $ ) ; |
238
|
|
|
|
|
|
|
sub assert_untied_referent ( $ ) ; |
239
|
|
|
|
|
|
|
sub assert_untied_scalar ( \$ ) ; |
240
|
|
|
|
|
|
|
sub assert_untied_scalarref ( $ ) ; |
241
|
|
|
|
|
|
|
sub assert_uppercased ( $ ) ; |
242
|
|
|
|
|
|
|
sub assert_void_context ( ) ; |
243
|
|
|
|
|
|
|
sub assert_whole_number ( $ ) ; |
244
|
|
|
|
|
|
|
sub assert_wide_characters ( $ ) ; |
245
|
|
|
|
|
|
|
sub assert_zero ( $ ) ; |
246
|
|
|
|
|
|
|
############################################################ |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub import { |
249
|
5
|
|
|
5
|
|
487858
|
my ($package, @conditional_imports) = @_; |
250
|
5
|
|
|
|
|
29
|
my @normal_imports = $package->_strip_import_conditions(@conditional_imports); |
251
|
5
|
50
|
|
|
|
30
|
if ($Assert_Never) { $package->SUPER::import(@normal_imports, -if => 0) } |
|
0
|
50
|
|
|
|
0
|
|
252
|
5
|
|
|
|
|
74
|
elsif ($Assert_Always) { $package->SUPER::import(@normal_imports, -if => 1) } |
253
|
0
|
|
|
|
|
0
|
else { $package->SUPER::import(@conditional_imports ) } |
254
|
5
|
|
|
|
|
78
|
$package->_reimport_nulled_code_protos(); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# This is just pretty extreme, but it's also about the only way to |
258
|
|
|
|
|
|
|
# make the Exporter shut up about things we sometimes need to do in |
259
|
|
|
|
|
|
|
# this module. |
260
|
|
|
|
|
|
|
# |
261
|
|
|
|
|
|
|
# Well, not quite the only way: there's always local *SIG. :) |
262
|
|
|
|
|
|
|
# |
263
|
|
|
|
|
|
|
# Otherwise it dribbles all over your screen when you try more than one |
264
|
|
|
|
|
|
|
# import, like importing a set and then reneging on a few of them. |
265
|
|
|
|
|
|
|
# |
266
|
|
|
|
|
|
|
# Newer versions of Carp appear not to need these heroics. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub export_to_level { |
269
|
5
|
|
|
5
|
0
|
234
|
my($package, $level, @export_args) = @_; |
270
|
|
|
|
|
|
|
|
271
|
5
|
|
|
|
|
19
|
state $old_carp = \&Carp::carp; |
272
|
5
|
|
|
|
|
31
|
state $filters = [ |
273
|
|
|
|
|
|
|
qr/^Constant subroutine \S+ redefined/, |
274
|
|
|
|
|
|
|
qr/^Subroutine \S+ redefined/, |
275
|
|
|
|
|
|
|
qr/^Prototype mismatch:/, |
276
|
|
|
|
|
|
|
]; |
277
|
|
|
|
|
|
|
|
278
|
3
|
|
|
3
|
|
5703
|
no warnings "redefine"; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
519
|
|
279
|
|
|
|
|
|
|
local *Carp::carp = sub { |
280
|
0
|
|
|
0
|
|
0
|
my($text) = @_; |
281
|
0
|
|
0
|
|
|
0
|
$text =~ $_ && return for @$filters; |
282
|
0
|
|
|
|
|
0
|
local $Carp::CarpInternal{"Exporter::Heavy"} = 1; |
283
|
0
|
|
|
|
|
0
|
$old_carp->($text); |
284
|
5
|
|
|
|
|
61
|
}; |
285
|
5
|
|
|
|
|
4354
|
$package->SUPER::export_to_level($level+2, @export_args); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# You have to do this if you have asserts that take a code |
289
|
|
|
|
|
|
|
# ref as their first argument and people want to use those |
290
|
|
|
|
|
|
|
# without parentheses. That's because the constant subroutine |
291
|
|
|
|
|
|
|
# that gets installed necessarily no longer has the prototype |
292
|
|
|
|
|
|
|
# needed to support a code ref in the dative slot syntactically. |
293
|
|
|
|
|
|
|
sub _reimport_nulled_code_protos { |
294
|
5
|
|
|
5
|
|
16
|
my($my_pack) = @_; |
295
|
5
|
|
|
|
|
16
|
my $his_pack = caller(1); |
296
|
|
|
|
|
|
|
|
297
|
3
|
|
|
3
|
|
30
|
no strict "refs"; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
916
|
|
298
|
|
|
|
|
|
|
|
299
|
5
|
|
|
|
|
12
|
for my $export (@{$my_pack . "::EXPORT_OK"}) { |
|
5
|
|
|
|
|
27
|
|
300
|
875
|
|
|
|
|
3030
|
my $real_proto = prototype($my_pack . "::$export"); |
301
|
875
|
100
|
100
|
|
|
5013
|
$real_proto && $real_proto =~ /^\s*&/ || next; |
302
|
10
|
|
|
|
|
40
|
my $his_func = $his_pack . "::$export"; |
303
|
10
|
100
|
|
|
|
63
|
defined &$his_func || next; |
304
|
6
|
50
|
|
|
|
27
|
prototype($his_func) && next; |
305
|
0
|
0
|
|
|
|
0
|
eval qq{ |
306
|
|
|
|
|
|
|
no warnings qw(prototype redefine); |
307
|
|
|
|
|
|
|
package $his_pack; |
308
|
|
|
|
|
|
|
sub $export ($real_proto) { 0 } |
309
|
|
|
|
|
|
|
1; |
310
|
|
|
|
|
|
|
} || panic "eval failed"; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# Remove the trailing -if/-unless from the conditional |
315
|
|
|
|
|
|
|
# import list. |
316
|
|
|
|
|
|
|
sub _strip_import_conditions { |
317
|
5
|
|
|
5
|
|
19
|
my($package, @args) = @_; |
318
|
5
|
|
|
|
|
13
|
my @export_args; |
319
|
5
|
|
50
|
|
|
52
|
while (@args && ($args[0] || '') !~ /^-(?:if|unless)$/) { |
|
|
|
100
|
|
|
|
|
320
|
5
|
|
|
|
|
29
|
push @export_args, shift @args; |
321
|
|
|
|
|
|
|
} |
322
|
5
|
|
|
|
|
19
|
return @export_args; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
################################################################ |
326
|
|
|
|
|
|
|
# The following attribute handler handler for subs saves |
327
|
|
|
|
|
|
|
# us a lot of bookkeeping trouble by letting us declare |
328
|
|
|
|
|
|
|
# which export tag groups a particular assert belongs to |
329
|
|
|
|
|
|
|
# at the point of declaration where it belongs, and so |
330
|
|
|
|
|
|
|
# that it is all handled automatically. |
331
|
|
|
|
|
|
|
################################################################ |
332
|
|
|
|
|
|
|
sub Assert : ATTR(CODE,BEGIN) |
333
|
|
|
|
|
|
|
{ |
334
|
525
|
|
|
525
|
0
|
791414
|
my($package, $symbol, $referent, $attr, $data, $phase, $filename, $linenum) = @_; |
335
|
3
|
|
|
3
|
|
25
|
no strict "refs"; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
731
|
|
336
|
525
|
|
|
|
|
875
|
my($subname, $tagref) = (*{$symbol}{NAME}, $data); |
|
525
|
|
|
|
|
1534
|
|
337
|
525
|
50
|
|
|
|
2927
|
$subname =~ /^assert_/ |
338
|
|
|
|
|
|
|
|| panic "$subname is not an assertion"; |
339
|
|
|
|
|
|
|
|
340
|
525
|
|
|
|
|
1207
|
my $his_export_ok = $package . "::EXPORT_OK"; |
341
|
525
|
|
|
|
|
1756
|
push @$his_export_ok, $subname; |
342
|
|
|
|
|
|
|
|
343
|
525
|
|
33
|
|
|
1983
|
my $debugging = $Exporter::Verbose || $Assert_Debug; |
344
|
|
|
|
|
|
|
|
345
|
525
|
50
|
|
|
|
1047
|
carp "Adding $subname to EXPORT_OK in $package at ",__FILE__," line ",__LINE__ if $debugging; |
346
|
|
|
|
|
|
|
|
347
|
525
|
50
|
33
|
|
|
1849
|
if (defined($tagref) && !ref($tagref)) { |
348
|
0
|
|
|
|
|
0
|
$tagref = [ $tagref ]; |
349
|
|
|
|
|
|
|
} |
350
|
525
|
|
|
|
|
911
|
my $his_export_tags = $package . "::EXPORT_TAGS"; |
351
|
525
|
|
|
|
|
1043
|
for my $tag (@$tagref, qw(all asserts)) { |
352
|
1770
|
|
|
|
|
2157
|
push @{ $his_export_tags->{$tag} }, $subname; |
|
1770
|
|
|
|
|
4736
|
|
353
|
1770
|
50
|
|
|
|
4461
|
carp "Adding $subname to EXPORT_TAG :$tag in $package at ",__FILE__," line ",__LINE__ if $debugging; |
354
|
|
|
|
|
|
|
} |
355
|
3
|
|
|
3
|
|
31
|
} |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
17
|
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
################################################################ |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Subs below are grouped by related type. Their documentation is |
360
|
|
|
|
|
|
|
# in the sub <DATA> pod. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub assert_list_context() |
363
|
|
|
|
|
|
|
:Assert( qw[context] ) |
364
|
|
|
|
|
|
|
{ |
365
|
5
|
|
|
5
|
1
|
4208
|
my $wantarray = his_context; |
366
|
5
|
100
|
|
|
|
41
|
$wantarray || botch "wanted to be called in list context"; |
367
|
3
|
|
|
3
|
|
4812
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub assert_nonlist_context() |
370
|
|
|
|
|
|
|
:Assert( qw[context] ) |
371
|
|
|
|
|
|
|
{ |
372
|
3
|
|
|
3
|
1
|
2561
|
my $wantarray = his_context; |
373
|
3
|
100
|
|
|
|
30
|
!$wantarray || botch "wanted to be called in nonlist context"; |
374
|
3
|
|
|
3
|
|
536
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub assert_scalar_context() |
377
|
|
|
|
|
|
|
:Assert( qw[context] ) |
378
|
|
|
|
|
|
|
{ |
379
|
3
|
|
|
3
|
1
|
2120
|
my $wantarray = his_context; |
380
|
3
|
100
|
100
|
|
|
36
|
defined($wantarray) && !$wantarray |
381
|
|
|
|
|
|
|
|| botch "wanted to be called in scalar context"; |
382
|
3
|
|
|
3
|
|
546
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub assert_void_context() |
385
|
|
|
|
|
|
|
:Assert( qw[context] ) |
386
|
|
|
|
|
|
|
{ |
387
|
3
|
|
|
3
|
1
|
2121
|
my $wantarray = his_context; |
388
|
3
|
100
|
|
|
|
47
|
!defined($wantarray) || botch "wanted to be called in void context"; |
389
|
3
|
|
|
3
|
|
599
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub assert_nonvoid_context() |
392
|
|
|
|
|
|
|
:Assert( qw[context] ) |
393
|
|
|
|
|
|
|
{ |
394
|
3
|
|
|
3
|
1
|
2602
|
my $wantarray = his_context; |
395
|
3
|
100
|
|
|
|
22
|
defined($wantarray) || botch "wanted to be called in nonvoid context"; |
396
|
3
|
|
|
3
|
|
537
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
sub assert_true($) |
399
|
|
|
|
|
|
|
:Assert( qw[scalar boolean] ) |
400
|
|
|
|
|
|
|
{ |
401
|
6
|
|
|
6
|
1
|
5407
|
my($arg) = @_; |
402
|
6
|
100
|
|
|
|
30
|
$arg || botch "expected true argument"; |
403
|
3
|
|
|
3
|
|
566
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub assert_false($) |
406
|
|
|
|
|
|
|
:Assert( qw[scalar boolean] ) |
407
|
|
|
|
|
|
|
{ |
408
|
6
|
|
|
6
|
1
|
5558
|
my($arg) = @_; |
409
|
6
|
100
|
|
|
|
32
|
$arg && botch "expected true argument"; |
410
|
|
|
|
|
|
|
|
411
|
3
|
|
|
3
|
|
586
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
10
|
|
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub assert_defined($) |
414
|
|
|
|
|
|
|
:Assert( qw[scalar] ) |
415
|
|
|
|
|
|
|
{ |
416
|
465
|
|
|
465
|
1
|
6760
|
my($value) = @_; |
417
|
465
|
100
|
|
|
|
1219
|
defined($value) || botch "expected defined value as argument"; |
418
|
3
|
|
|
3
|
|
544
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
sub assert_undefined($) |
421
|
|
|
|
|
|
|
:Assert( qw[scalar] ) |
422
|
|
|
|
|
|
|
{ |
423
|
3
|
|
|
3
|
1
|
2594
|
my($scalar) = @_; |
424
|
3
|
100
|
|
|
|
19
|
defined($scalar) && botch "expected undefined argument"; |
425
|
3
|
|
|
3
|
|
548
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
10
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub assert_defined_variable(\$) |
428
|
|
|
|
|
|
|
:Assert( qw[scalar] ) |
429
|
|
|
|
|
|
|
{ |
430
|
2
|
|
|
2
|
1
|
1550
|
&assert_scalarref; |
431
|
2
|
|
|
|
|
6
|
my($sref) = @_; |
432
|
2
|
100
|
|
|
|
20
|
defined($$sref) || botch "expected defined scalar variable as argument"; |
433
|
3
|
|
|
3
|
|
581
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub assert_defined_value($) |
436
|
|
|
|
|
|
|
:Assert( qw[scalar] ) |
437
|
|
|
|
|
|
|
{ |
438
|
3
|
|
|
3
|
1
|
2661
|
my($value) = @_; |
439
|
3
|
100
|
|
|
|
19
|
defined($value) || botch "expected defined value as argument"; |
440
|
3
|
|
|
3
|
|
564
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub assert_is($$) |
443
|
|
|
|
|
|
|
:Assert( qw[string] ) |
444
|
|
|
|
|
|
|
{ |
445
|
5
|
|
|
5
|
1
|
9731
|
my($this, $that) = @_; |
446
|
5
|
|
|
|
|
28
|
assert_defined($_) for $this, $that; |
447
|
4
|
|
|
|
|
25
|
assert_nonref($_) for $this, $that; |
448
|
4
|
100
|
|
|
|
41
|
$this eq $that || botch "string '$this' should be '$that'"; |
449
|
3
|
|
|
3
|
|
682
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
32
|
|
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub assert_isnt($$) |
452
|
|
|
|
|
|
|
:Assert( qw[string] ) |
453
|
|
|
|
|
|
|
{ |
454
|
4
|
|
|
4
|
1
|
2835
|
my($this, $that) = @_; |
455
|
4
|
|
|
|
|
19
|
assert_defined($_) for $this, $that; |
456
|
4
|
|
|
|
|
16
|
assert_nonref($_) for $this, $that; |
457
|
2
|
100
|
|
|
|
17
|
$this ne $that || botch "string '$this' should not be '$that'"; |
458
|
3
|
|
|
3
|
|
760
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub assert_numeric($) |
461
|
|
|
|
|
|
|
:Assert( qw[number] ) |
462
|
|
|
|
|
|
|
{ |
463
|
284
|
|
|
284
|
1
|
4721
|
&assert_defined; |
464
|
276
|
|
|
|
|
620
|
&assert_nonref; |
465
|
276
|
|
|
|
|
444
|
my($n) = @_; |
466
|
276
|
100
|
|
|
|
823
|
looks_like_number($n) || botch "'$n' doesn't look like a number"; |
467
|
3
|
|
|
3
|
|
595
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
11
|
|
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub assert_nonnumeric($) |
470
|
|
|
|
|
|
|
:Assert( qw[number] ) |
471
|
|
|
|
|
|
|
{ |
472
|
5
|
|
|
5
|
1
|
3113
|
&assert_nonref; |
473
|
5
|
|
|
|
|
13
|
my($n) = @_; |
474
|
5
|
100
|
|
|
|
45
|
!looks_like_number($n) || botch "'$n' looks like a number"; |
475
|
3
|
|
|
3
|
|
577
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
23
|
|
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
sub assert_positive($) |
478
|
|
|
|
|
|
|
:Assert( qw[number] ) |
479
|
|
|
|
|
|
|
{ |
480
|
11
|
|
|
11
|
1
|
2077
|
&assert_numeric; |
481
|
11
|
|
|
|
|
27
|
my($n) = @_; |
482
|
11
|
100
|
|
|
|
62
|
$n > 0 || botch "$n should be positive"; |
483
|
3
|
|
|
3
|
|
566
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
sub assert_nonpositive($) |
486
|
|
|
|
|
|
|
:Assert( qw[number] ) |
487
|
|
|
|
|
|
|
{ |
488
|
6
|
|
|
6
|
1
|
1568
|
&assert_numeric; |
489
|
6
|
|
|
|
|
30
|
my($n) = @_; |
490
|
6
|
100
|
|
|
|
23
|
$n <= 0 || botch "$n should not be positive"; |
491
|
3
|
|
|
3
|
|
571
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
11
|
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub assert_negative($) |
494
|
|
|
|
|
|
|
:Assert( qw[number] ) |
495
|
|
|
|
|
|
|
{ |
496
|
6
|
|
|
6
|
1
|
1976
|
&assert_numeric; |
497
|
6
|
|
|
|
|
15
|
my($n) = @_; |
498
|
6
|
100
|
|
|
|
41
|
$n < 0 || botch "$n should be negative"; |
499
|
3
|
|
|
3
|
|
593
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
12
|
|
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
sub assert_nonnegative($) |
502
|
|
|
|
|
|
|
:Assert( qw[number] ) |
503
|
|
|
|
|
|
|
{ |
504
|
87
|
|
|
87
|
1
|
1732
|
&assert_numeric; |
505
|
87
|
|
|
|
|
198
|
my($n) = @_; |
506
|
87
|
100
|
|
|
|
215
|
$n >= 0 || botch "$n should not be negative"; |
507
|
3
|
|
|
3
|
|
683
|
} |
|
3
|
|
|
|
|
39
|
|
|
3
|
|
|
|
|
25
|
|
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub assert_zero($) |
510
|
|
|
|
|
|
|
:Assert( qw[number] ) |
511
|
|
|
|
|
|
|
{ |
512
|
6
|
|
|
6
|
1
|
5164
|
&assert_numeric; |
513
|
5
|
|
|
|
|
19
|
my($n) = @_; |
514
|
5
|
100
|
|
|
|
26
|
$n == 0 || botch "$n should be zero"; |
515
|
3
|
|
|
3
|
|
570
|
} |
|
3
|
|
|
|
|
36
|
|
|
3
|
|
|
|
|
10
|
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub assert_nonzero($) |
518
|
|
|
|
|
|
|
:Assert( qw[number] ) |
519
|
|
|
|
|
|
|
{ |
520
|
3
|
|
|
3
|
1
|
2898
|
&assert_numeric; |
521
|
2
|
|
|
|
|
13
|
my($n) = @_; |
522
|
2
|
100
|
|
|
|
20
|
$n != 0 || botch "$n should not be zero"; |
523
|
3
|
|
|
3
|
|
567
|
} |
|
3
|
|
|
|
|
43
|
|
|
3
|
|
|
|
|
16
|
|
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
sub assert_integer($) |
526
|
|
|
|
|
|
|
:Assert( qw[number] ) |
527
|
|
|
|
|
|
|
{ |
528
|
131
|
|
|
131
|
1
|
1889
|
&assert_numeric; |
529
|
115
|
|
|
|
|
204
|
my($int) = @_; |
530
|
115
|
100
|
|
|
|
371
|
$int == int($int) || botch "expected integer, not $int"; |
531
|
3
|
|
|
3
|
|
584
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub assert_fractional($) |
534
|
|
|
|
|
|
|
:Assert( qw[number] ) |
535
|
|
|
|
|
|
|
{ |
536
|
2
|
|
|
2
|
1
|
11770
|
&assert_numeric; |
537
|
2
|
|
|
|
|
10
|
my($float) = @_; |
538
|
2
|
100
|
|
|
|
17
|
$float != int($float) || botch "expected fractional part, not $float"; |
539
|
3
|
|
|
3
|
|
608
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub assert_signed_number($) |
542
|
|
|
|
|
|
|
:Assert( qw[number] ) |
543
|
|
|
|
|
|
|
{ |
544
|
5
|
|
|
5
|
1
|
14598
|
&assert_numeric; |
545
|
5
|
|
|
|
|
18
|
my($n) = @_; |
546
|
5
|
100
|
|
|
|
36
|
$n =~ /^ [-+] /x || botch "expected signed number, not $n"; |
547
|
3
|
|
|
3
|
|
641
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
sub assert_natural_number($) |
550
|
|
|
|
|
|
|
:Assert( qw[number] ) |
551
|
|
|
|
|
|
|
{ |
552
|
5
|
|
|
5
|
1
|
4102
|
&assert_positive_integer; |
553
|
3
|
|
|
|
|
8
|
my($int) = @_; |
554
|
3
|
|
|
3
|
|
537
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
14
|
|
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub assert_whole_number($) |
557
|
|
|
|
|
|
|
:Assert( qw[number] ) |
558
|
|
|
|
|
|
|
{ |
559
|
86
|
|
|
86
|
1
|
4904
|
&assert_nonnegative_integer; |
560
|
80
|
|
|
|
|
151
|
my($int) = @_; |
561
|
3
|
|
|
3
|
|
569
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
9
|
|
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub assert_positive_integer($) |
564
|
|
|
|
|
|
|
:Assert( qw[number] ) |
565
|
|
|
|
|
|
|
{ |
566
|
11
|
|
|
11
|
1
|
4095
|
&assert_integer; |
567
|
8
|
|
|
|
|
27
|
&assert_positive; |
568
|
3
|
|
|
3
|
|
535
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub assert_nonpositive_integer($) |
571
|
|
|
|
|
|
|
:Assert( qw[number] ) |
572
|
|
|
|
|
|
|
{ |
573
|
6
|
|
|
6
|
1
|
5117
|
&assert_integer; |
574
|
4
|
|
|
|
|
27
|
&assert_nonpositive; |
575
|
3
|
|
|
3
|
|
574
|
} |
|
3
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
17
|
|
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub assert_negative_integer($) |
578
|
|
|
|
|
|
|
:Assert( qw[number] ) |
579
|
|
|
|
|
|
|
{ |
580
|
8
|
|
|
8
|
1
|
5057
|
&assert_integer; |
581
|
4
|
|
|
|
|
11
|
&assert_negative; |
582
|
3
|
|
|
3
|
|
582
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
12
|
|
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
sub assert_nonnegative_integer($) |
585
|
|
|
|
|
|
|
:Assert( qw[number] ) |
586
|
|
|
|
|
|
|
{ |
587
|
92
|
|
|
92
|
1
|
4809
|
&assert_integer; |
588
|
85
|
|
|
|
|
169
|
&assert_nonnegative; |
589
|
3
|
|
|
3
|
|
485
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
sub assert_hex_number($) |
592
|
|
|
|
|
|
|
:Assert( qw[regex number] ) |
593
|
|
|
|
|
|
|
{ |
594
|
5
|
|
|
5
|
1
|
4113
|
local($_) = @_; |
595
|
5
|
100
|
|
|
|
52
|
/^ (?:0x)? \p{ahex}+ \z/ix || botch "expected only ASCII hex digits in string '$_'"; |
596
|
3
|
|
|
3
|
|
1155
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
sub assert_box_number($) |
599
|
|
|
|
|
|
|
:Assert( qw[number] ) |
600
|
|
|
|
|
|
|
{ |
601
|
14
|
|
|
14
|
1
|
10759
|
local($_) = @_; |
602
|
14
|
|
|
|
|
42
|
&assert_defined; |
603
|
12
|
100
|
100
|
|
|
162
|
/^ (?: 0b ) [0-1]+ \z /x || |
|
|
|
100
|
|
|
|
|
604
|
|
|
|
|
|
|
/^ (?: 0o | 0)? [0-7]+ \z /x || |
605
|
|
|
|
|
|
|
/^ (?: 0x ) [0-9a-fA-F]+ \z /x |
606
|
|
|
|
|
|
|
|| botch "I wouldn't feed '$_' to oct() if I were you"; |
607
|
3
|
|
|
3
|
|
817
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub assert_even_number($) |
610
|
|
|
|
|
|
|
:Assert( qw[number] ) |
611
|
|
|
|
|
|
|
{ |
612
|
6
|
|
|
6
|
1
|
4155
|
&assert_integer; |
613
|
3
|
|
|
|
|
12
|
my($n) = @_; |
614
|
3
|
100
|
|
|
|
26
|
$n % 2 == 0 || botch "$n should be even"; |
615
|
3
|
|
|
3
|
|
619
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
sub assert_odd_number($) |
618
|
|
|
|
|
|
|
:Assert( qw[number] ) |
619
|
|
|
|
|
|
|
{ |
620
|
6
|
|
|
6
|
1
|
3586
|
&assert_integer; |
621
|
2
|
|
|
|
|
6
|
my($n) = @_; |
622
|
2
|
100
|
|
|
|
26
|
$n % 2 == 1 || botch "$n should be odd"; |
623
|
3
|
|
|
3
|
|
585
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
10
|
|
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub assert_in_numeric_range($$$) |
626
|
|
|
|
|
|
|
:Assert( qw[number] ) |
627
|
|
|
|
|
|
|
{ |
628
|
8
|
|
|
8
|
1
|
5719
|
assert_numeric($_) for my($n, $low, $high) = @_; |
629
|
7
|
100
|
100
|
|
|
61
|
$n >= $low && $n <= $high || botch "expected $low <= $n <= $high"; |
630
|
3
|
|
|
3
|
|
712
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
16
|
|
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub assert_empty($) |
633
|
|
|
|
|
|
|
:Assert( qw[string] ) |
634
|
|
|
|
|
|
|
{ |
635
|
5
|
|
|
5
|
1
|
4503
|
&assert_defined; |
636
|
4
|
|
|
|
|
13
|
&assert_nonref; |
637
|
4
|
|
|
|
|
16
|
my($string) = @_; |
638
|
4
|
100
|
|
|
|
22
|
length($string) == 0 || botch "expected zero-length string"; |
639
|
3
|
|
|
3
|
|
591
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
11
|
|
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub assert_nonempty($) |
642
|
|
|
|
|
|
|
:Assert( qw[string] ) |
643
|
|
|
|
|
|
|
{ |
644
|
87
|
|
|
87
|
1
|
4258
|
&assert_defined; |
645
|
84
|
|
|
|
|
216
|
&assert_nonref; |
646
|
71
|
|
|
|
|
126
|
my($string) = @_; |
647
|
71
|
100
|
|
|
|
194
|
length($string) != 0 || botch "expected non-zero-length string"; |
648
|
3
|
|
|
3
|
|
577
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub assert_blank($) |
651
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
652
|
|
|
|
|
|
|
{ |
653
|
36
|
|
|
36
|
1
|
35777
|
&assert_defined; |
654
|
35
|
|
|
|
|
101
|
&assert_nonref; |
655
|
34
|
|
|
|
|
70
|
my($string) = @_; |
656
|
34
|
100
|
|
|
|
169
|
$string =~ /^ \p{whitespace}* \z/x || botch "found non-whitespace in string '$string'" |
657
|
3
|
|
|
3
|
|
2443
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
16
|
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub assert_nonblank($) |
660
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
661
|
|
|
|
|
|
|
{ |
662
|
2
|
|
|
2
|
1
|
7127
|
&assert_defined; |
663
|
2
|
|
|
|
|
8
|
&assert_nonref; |
664
|
2
|
|
|
|
|
10
|
my($string) = @_; |
665
|
2
|
100
|
|
|
|
34
|
$string =~ / \P{whitespace}/x || botch "found no non-whitespace in string '$string'" |
666
|
3
|
|
|
3
|
|
1093
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
my $_single_line_rx = qr{ |
669
|
|
|
|
|
|
|
\A |
670
|
|
|
|
|
|
|
( (?! \R ) \X )+ |
671
|
|
|
|
|
|
|
\R ? |
672
|
|
|
|
|
|
|
\z |
673
|
|
|
|
|
|
|
}x; |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub assert_single_line($) |
676
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
677
|
|
|
|
|
|
|
{ |
678
|
20
|
|
|
20
|
1
|
15387
|
&assert_nonempty; |
679
|
18
|
|
|
|
|
33
|
my($string) = @_; |
680
|
18
|
100
|
|
|
|
199
|
$string =~ $_single_line_rx || botch "expected at most a single linebreak at the end"; |
681
|
3
|
|
|
3
|
|
692
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
sub assert_multi_line($) |
684
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
685
|
|
|
|
|
|
|
{ |
686
|
14
|
|
|
14
|
1
|
12441
|
&assert_nonempty; |
687
|
12
|
|
|
|
|
36
|
my($string) = @_; |
688
|
12
|
100
|
|
|
|
157
|
$string !~ $_single_line_rx || botch "expected more than one linebreak"; |
689
|
3
|
|
|
3
|
|
573
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
11
|
|
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
sub assert_single_paragraph($) |
692
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
693
|
|
|
|
|
|
|
{ |
694
|
21
|
|
|
21
|
1
|
16546
|
&assert_nonempty; |
695
|
21
|
|
|
|
|
45
|
my($string) = @_; |
696
|
21
|
100
|
|
|
|
193
|
$string =~ / \A ( (?! \R ) \X )+ \R* \z /x |
697
|
|
|
|
|
|
|
|| botch "expected at most a single linebreak at the end"; |
698
|
3
|
|
|
3
|
|
695
|
} |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
12
|
|
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub assert_bytes($) |
701
|
|
|
|
|
|
|
:Assert( qw[string] ) |
702
|
|
|
|
|
|
|
{ |
703
|
5
|
|
|
5
|
1
|
2124
|
local($_) = @_; |
704
|
5
|
100
|
|
|
|
37
|
/^ [\x00-\xFF] + \z/x || botch "unexpected wide characters in byte string"; |
705
|
3
|
|
|
3
|
|
671
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
sub assert_nonbytes($) |
708
|
|
|
|
|
|
|
:Assert( qw[string] ) |
709
|
|
|
|
|
|
|
{ |
710
|
3
|
|
|
3
|
1
|
2068
|
&assert_wide_characters; |
711
|
3
|
|
|
3
|
|
488
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
11
|
|
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub assert_wide_characters($) |
714
|
|
|
|
|
|
|
:Assert( qw[string] ) |
715
|
|
|
|
|
|
|
{ |
716
|
5
|
|
|
5
|
1
|
2008
|
local($_) = @_; |
717
|
5
|
100
|
|
|
|
41
|
/[^\x00-\xFF]/x || botch "expected some wide characters in string"; |
718
|
3
|
|
|
3
|
|
643
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub assert_nonascii($) |
721
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
722
|
|
|
|
|
|
|
{ |
723
|
2
|
|
|
2
|
1
|
1580
|
local($_) = @_; |
724
|
2
|
100
|
|
|
|
18
|
/\P{ascii}/x || botch "expected non-ASCII in string"; |
725
|
3
|
|
|
3
|
|
1031
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
14
|
|
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub assert_ascii($) |
728
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
729
|
|
|
|
|
|
|
{ |
730
|
2
|
|
|
2
|
1
|
1591
|
local($_) = @_; |
731
|
2
|
100
|
|
|
|
30
|
/^ \p{ASCII} + \z/x || botch "expected only ASCII in string"; |
732
|
3
|
|
|
3
|
|
1010
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
16
|
|
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub assert_alphabetic($) |
735
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
736
|
|
|
|
|
|
|
{ |
737
|
2
|
|
|
2
|
1
|
14460
|
local($_) = @_; |
738
|
2
|
100
|
|
|
|
31
|
/^ \p{alphabetic} + \z/x || botch "expected only alphabetics in string"; |
739
|
3
|
|
|
3
|
|
3143
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
17
|
|
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub assert_nonalphabetic($) |
742
|
|
|
|
|
|
|
:Assert( qw[string regex] ) |
743
|
|
|
|
|
|
|
{ |
744
|
2
|
|
|
2
|
1
|
1672
|
local($_) = @_; |
745
|
2
|
100
|
|
|
|
28
|
/^ \P{alphabetic} + \z/x || botch "expected only non-alphabetics in string"; |
746
|
3
|
|
|
3
|
|
1188
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub assert_alnum($) |
749
|
|
|
|
|
|
|
:Assert( qw[regex] ) |
750
|
|
|
|
|
|
|
{ |
751
|
2
|
|
|
2
|
1
|
1621
|
local($_) = @_; |
752
|
2
|
100
|
|
|
|
25
|
/^ \p{alnum} + \z/x || botch "expected only alphanumerics in string"; |
753
|
3
|
|
|
3
|
|
3102
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
17
|
|
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
sub assert_digits($) |
756
|
|
|
|
|
|
|
:Assert( qw[regex number] ) |
757
|
|
|
|
|
|
|
{ |
758
|
2
|
|
|
2
|
1
|
1552
|
local($_) = @_; |
759
|
2
|
100
|
|
|
|
32
|
/^ [0-9] + \z/x || botch "expected only ASCII digits in string"; |
760
|
3
|
|
|
3
|
|
612
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
13
|
|
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
sub assert_uppercased($) |
763
|
|
|
|
|
|
|
:Assert( qw[case regex] ) |
764
|
|
|
|
|
|
|
{ |
765
|
3
|
|
|
3
|
1
|
2287
|
local($_) = @_; |
766
|
3
|
50
|
|
|
|
33
|
($] >= 5.014 |
|
|
100
|
|
|
|
|
|
767
|
|
|
|
|
|
|
? ! /\p{Changes_When_Uppercased}/ |
768
|
|
|
|
|
|
|
: $_ eq uc ) || botch "changes case when uppercased"; |
769
|
3
|
|
|
3
|
|
4057
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
19
|
|
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
sub assert_lowercased($) |
772
|
|
|
|
|
|
|
:Assert( qw[case regex] ) |
773
|
|
|
|
|
|
|
{ |
774
|
2
|
|
|
2
|
1
|
1551
|
local($_) = @_; |
775
|
2
|
50
|
|
|
|
71
|
($] >= 5.014 |
|
|
100
|
|
|
|
|
|
776
|
|
|
|
|
|
|
? ! /\p{Changes_When_Lowercased}/ |
777
|
|
|
|
|
|
|
: $_ eq lc ) || botch "changes case when lowercased"; |
778
|
3
|
|
|
3
|
|
3902
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
17
|
|
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
sub assert_unicode_ident($) |
781
|
|
|
|
|
|
|
:Assert( qw[regex] ) |
782
|
|
|
|
|
|
|
{ |
783
|
2
|
|
|
2
|
1
|
1667
|
local($_) = @_; |
784
|
2
|
100
|
|
|
|
32
|
/^ \p{XID_Start} \p{XID_Continue}* \z/x |
785
|
|
|
|
|
|
|
|| botch "invalid identifier $_"; |
786
|
3
|
|
|
3
|
|
5441
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
18
|
|
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
# This is a lie. |
789
|
|
|
|
|
|
|
my $perl_simple_ident_rx = qr{ |
790
|
|
|
|
|
|
|
\b |
791
|
|
|
|
|
|
|
[\p{gc=Connector_Punctuation}\p{XID_Start}] |
792
|
|
|
|
|
|
|
\p{XID_Continue} *+ |
793
|
|
|
|
|
|
|
\b |
794
|
|
|
|
|
|
|
}x; |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
my $perl_qualified_ident_rx = qr{ |
797
|
|
|
|
|
|
|
(?: $perl_simple_ident_rx |
798
|
|
|
|
|
|
|
| (?: :: | ' ) |
799
|
|
|
|
|
|
|
) + |
800
|
|
|
|
|
|
|
}x; |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
sub assert_simple_perl_ident($) |
803
|
|
|
|
|
|
|
:Assert( qw[regex ident] ) |
804
|
|
|
|
|
|
|
{ |
805
|
2
|
|
|
2
|
1
|
1633
|
local($_) = @_; |
806
|
2
|
100
|
|
|
|
50
|
/^ $perl_simple_ident_rx \z/x |
807
|
|
|
|
|
|
|
|| botch "invalid simple perl identifier $_"; |
808
|
3
|
|
|
3
|
|
3110
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
sub assert_full_perl_ident($) |
811
|
|
|
|
|
|
|
:Assert( qw[regex ident] ) |
812
|
|
|
|
|
|
|
{ |
813
|
5
|
|
|
5
|
1
|
2051
|
local($_) = @_; |
814
|
5
|
100
|
|
|
|
100
|
/^ $perl_qualified_ident_rx \z/x |
815
|
|
|
|
|
|
|
|| botch "invalid qualified perl identifier $_"; |
816
|
3
|
|
|
3
|
|
597
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
11
|
|
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub assert_qualified_ident($) |
819
|
|
|
|
|
|
|
:Assert( qw[regex ident] ) |
820
|
|
|
|
|
|
|
{ |
821
|
3
|
|
|
3
|
1
|
2524
|
&assert_full_perl_ident; |
822
|
2
|
|
|
|
|
10
|
local($_) = @_; |
823
|
2
|
100
|
|
|
|
22
|
/(?: ' | :: ) /x || botch "no package separators in $_"; |
824
|
3
|
|
|
3
|
|
664
|
} |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
14
|
|
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
sub assert_ascii_ident($) |
827
|
|
|
|
|
|
|
:Assert( qw[regex ident] ) |
828
|
|
|
|
|
|
|
{ |
829
|
2
|
|
|
2
|
1
|
1591
|
local($_) = @_; |
830
|
2
|
100
|
|
|
|
39
|
/^ (?= \p{ASCII}+ \z) (?! \d) \w+ \z/x |
831
|
|
|
|
|
|
|
|| botch q(expected only ASCII \\w characters in string); |
832
|
3
|
|
|
3
|
|
1162
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
sub assert_regex($) |
835
|
|
|
|
|
|
|
:Assert( qw[regex] ) |
836
|
|
|
|
|
|
|
{ |
837
|
7
|
|
|
7
|
1
|
1633
|
my($pattern) = @_; |
838
|
7
|
|
|
|
|
34
|
assert_isa($pattern, "Regexp"); |
839
|
3
|
|
|
3
|
|
559
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub assert_like($$) |
842
|
|
|
|
|
|
|
:Assert( qw[regex] ) |
843
|
|
|
|
|
|
|
{ |
844
|
3
|
|
|
3
|
1
|
2241
|
my($string, $pattern) = @_; |
845
|
3
|
|
|
|
|
16
|
assert_defined($string); |
846
|
3
|
|
|
|
|
17
|
assert_nonref($string); |
847
|
3
|
|
|
|
|
12
|
assert_regex($pattern); |
848
|
2
|
100
|
|
|
|
41
|
$string =~ $pattern || botch "'$string' did not match $pattern"; |
849
|
3
|
|
|
3
|
|
698
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
sub assert_unlike($$) |
852
|
|
|
|
|
|
|
:Assert( qw[regex] ) |
853
|
|
|
|
|
|
|
{ |
854
|
2
|
|
|
2
|
1
|
1593
|
my($string, $pattern) = @_; |
855
|
2
|
|
|
|
|
11
|
assert_defined($string); |
856
|
2
|
|
|
|
|
17
|
assert_nonref($string); |
857
|
2
|
|
|
|
|
12
|
assert_regex($pattern); |
858
|
2
|
100
|
|
|
|
52
|
$string !~ $pattern || botch "'$string' should not match $pattern"; |
859
|
3
|
|
|
3
|
|
736
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
19
|
|
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
sub assert_latin1($) |
862
|
|
|
|
|
|
|
:Assert( qw[string unicode] ) |
863
|
|
|
|
|
|
|
{ |
864
|
3
|
|
|
3
|
1
|
2152
|
&assert_bytes; |
865
|
3
|
|
|
3
|
|
490
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
sub assert_latinish($) |
868
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
869
|
|
|
|
|
|
|
{ |
870
|
2
|
|
|
2
|
1
|
1882
|
local($_) = @_; |
871
|
2
|
100
|
|
|
|
35
|
/^[\p{Latin}\p{Common}\p{Inherited}]+/ |
872
|
|
|
|
|
|
|
|| botch "expected only Latinish characters in string"; |
873
|
3
|
|
|
3
|
|
6541
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
17
|
|
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
sub assert_astral($) |
876
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
877
|
|
|
|
|
|
|
{ |
878
|
2
|
|
|
2
|
1
|
1557
|
local($_) = @_; |
879
|
3
|
|
|
3
|
|
519
|
no warnings "utf8"; # early versions of perl complain of illegal for interchange on FFFF |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
253
|
|
880
|
2
|
100
|
|
|
|
22
|
/[^\x00-\x{FFFF}]/x || botch "expected non-BMP characters in string"; |
881
|
3
|
|
|
3
|
|
21
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
sub assert_nonastral($) |
884
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
885
|
|
|
|
|
|
|
{ |
886
|
4
|
|
|
4
|
1
|
1618
|
local($_) = @_; |
887
|
3
|
|
|
3
|
|
694
|
no warnings "utf8"; # early versions of perl complain of illegal for interchange on FFFF |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
295
|
|
888
|
4
|
100
|
|
|
|
49
|
/^ [\x00-\x{FFFF}] * \z/x || botch "unexpected non-BMP characters in string"; |
889
|
3
|
|
|
3
|
|
23
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub assert_bmp($) |
892
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
893
|
|
|
|
|
|
|
{ |
894
|
2
|
|
|
2
|
1
|
1551
|
&assert_nonastral; |
895
|
3
|
|
|
3
|
|
485
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
sub assert_nfc($) |
898
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
899
|
|
|
|
|
|
|
{ |
900
|
3
|
|
|
3
|
1
|
2187
|
my($str) = @_; |
901
|
3
|
100
|
66
|
|
|
54
|
checkNFC($str) // $str eq NFC($str) |
902
|
|
|
|
|
|
|
|| botch "string not in NFC form"; |
903
|
3
|
|
|
3
|
|
610
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub assert_nfkc($) |
906
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
907
|
|
|
|
|
|
|
{ |
908
|
3
|
|
|
3
|
1
|
2178
|
my($str) = @_; |
909
|
3
|
100
|
33
|
|
|
44
|
checkNFKC($str) // $str eq NFKC($str) |
910
|
|
|
|
|
|
|
|| botch "string not in NFKC form"; |
911
|
3
|
|
|
3
|
|
601
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub assert_nfd($) |
914
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
915
|
|
|
|
|
|
|
{ |
916
|
3
|
|
|
3
|
1
|
2127
|
my($str) = @_; |
917
|
3
|
100
|
|
|
|
33
|
checkNFD($str) || botch "string not in NFD form"; |
918
|
3
|
|
|
3
|
|
612
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
sub assert_nfkd($) |
921
|
|
|
|
|
|
|
:Assert( qw[unicode] ) |
922
|
|
|
|
|
|
|
{ |
923
|
4
|
|
|
4
|
1
|
2587
|
my($str) = @_; |
924
|
4
|
100
|
|
|
|
48
|
checkNFKD($str) || botch "string not in NFKD form"; |
925
|
3
|
|
|
3
|
|
572
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
14
|
|
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
sub assert_eq($$) |
928
|
|
|
|
|
|
|
:Assert( qw[string unicode] ) |
929
|
|
|
|
|
|
|
{ |
930
|
2
|
|
|
2
|
1
|
1652
|
my($this, $that) = @_; |
931
|
2
|
100
|
|
|
|
38
|
NFC($this) eq NFC($that) || botch "'$this' and '$that' are not equivalent Unicode strings"; |
932
|
3
|
|
|
3
|
|
609
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
sub assert_eq_letters($$) |
935
|
|
|
|
|
|
|
:Assert( qw[string unicode] ) |
936
|
|
|
|
|
|
|
{ |
937
|
6
|
|
|
6
|
1
|
7548
|
my($this, $that) = @_; |
938
|
6
|
100
|
|
|
|
41
|
UCA1($this) eq UCA1($that) || botch "'$this' and '$that' do not equivalent letters" |
939
|
3
|
|
|
3
|
|
670
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
16
|
|
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
sub assert_in_list($@) |
942
|
|
|
|
|
|
|
:Assert( qw[list] ) |
943
|
|
|
|
|
|
|
{ |
944
|
12
|
|
|
12
|
1
|
10018
|
my($needle, @haystack) = @_; |
945
|
|
|
|
|
|
|
#assert_nonref($needle); |
946
|
12
|
|
|
|
|
27
|
my $undef_needle = !defined($needle); |
947
|
12
|
|
|
|
|
31
|
for my $straw (@haystack) { |
948
|
|
|
|
|
|
|
#assert_nonref($straw); |
949
|
69
|
100
|
66
|
|
|
261
|
return if $undef_needle |
|
|
100
|
|
|
|
|
|
950
|
|
|
|
|
|
|
? !defined($straw) |
951
|
|
|
|
|
|
|
: ("$needle" eq (defined($straw) && "$straw")) |
952
|
|
|
|
|
|
|
} |
953
|
6
|
100
|
|
|
|
19
|
$needle = "undef" unless defined $needle; |
954
|
6
|
100
|
|
|
|
22
|
botch "couldn't find $needle in " . join(", " => map { defined() ? $_ : "undef" } @haystack); |
|
38
|
|
|
|
|
103
|
|
955
|
3
|
|
|
3
|
|
853
|
} |
|
3
|
|
|
|
|
25
|
|
|
3
|
|
|
|
|
13
|
|
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
sub assert_not_in_list($@) |
958
|
|
|
|
|
|
|
:Assert( qw[list] ) |
959
|
|
|
|
|
|
|
{ |
960
|
12
|
|
|
12
|
1
|
9654
|
my($needle, @haystack) = @_; |
961
|
12
|
|
|
|
|
29
|
my $found = 0; |
962
|
12
|
|
|
|
|
38
|
for my $straw (@haystack) { |
963
|
69
|
100
|
|
|
|
109
|
if (defined $needle) { |
964
|
47
|
100
|
|
|
|
84
|
next if !defined $straw; |
965
|
44
|
100
|
|
|
|
117
|
if ("$needle" eq "$straw") { |
966
|
4
|
|
|
|
|
14
|
$found = 1; |
967
|
4
|
|
|
|
|
10
|
last; |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} else { |
970
|
22
|
100
|
|
|
|
73
|
next if defined $straw; |
971
|
2
|
|
|
|
|
8
|
$found = 1; |
972
|
2
|
|
|
|
|
5
|
last; |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
} |
975
|
12
|
100
|
|
|
|
41
|
return unless $found; |
976
|
6
|
100
|
|
|
|
26
|
$needle = "undef" unless defined $needle; |
977
|
6
|
|
|
|
|
32
|
botch "found $needle in forbidden list"; |
978
|
3
|
|
|
3
|
|
907
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
sub assert_list_nonempty( @ ) |
981
|
|
|
|
|
|
|
:Assert( qw[list array] ) |
982
|
|
|
|
|
|
|
{ |
983
|
3
|
100
|
|
3
|
1
|
10768
|
@_ || botch "list is empty"; |
984
|
3
|
|
|
3
|
|
518
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
25
|
|
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
sub assert_array_nonempty( \@ ) |
987
|
|
|
|
|
|
|
:Assert( qw[array] ) |
988
|
|
|
|
|
|
|
{ |
989
|
2
|
|
|
2
|
1
|
1597
|
&assert_arrayref_nonempty; |
990
|
3
|
|
|
3
|
|
524
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
11
|
|
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
sub assert_arrayref_nonempty( $ ) |
993
|
|
|
|
|
|
|
:Assert( qw[array] ) |
994
|
|
|
|
|
|
|
{ |
995
|
7
|
|
|
7
|
1
|
12553
|
&assert_array_length; |
996
|
3
|
|
|
|
|
6
|
my($aref) = @_; |
997
|
3
|
|
|
|
|
10
|
assert_arrayref($aref); |
998
|
3
|
|
|
|
|
4
|
my $count = @$aref; |
999
|
3
|
50
|
|
|
|
10
|
$count > 0 || botch("array is empty"); |
1000
|
3
|
|
|
3
|
|
699
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
28
|
|
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
sub assert_array_length( \@ ;$ ) |
1003
|
|
|
|
|
|
|
:Assert( qw[array] ) |
1004
|
|
|
|
|
|
|
{ |
1005
|
11
|
100
|
|
11
|
1
|
3457
|
if (@_ == 1) { |
1006
|
9
|
|
|
|
|
36
|
assert_array_length_min(@{$_[0]} => 1); |
|
9
|
|
|
|
|
48
|
|
1007
|
4
|
|
|
|
|
10
|
return; |
1008
|
|
|
|
|
|
|
} |
1009
|
2
|
|
|
|
|
19
|
my($aref, $want) = @_; |
1010
|
2
|
|
|
|
|
9
|
assert_arrayref($aref); |
1011
|
2
|
|
|
|
|
13
|
assert_whole_number($want); |
1012
|
2
|
|
|
|
|
19
|
my $have = @$aref; |
1013
|
2
|
100
|
|
|
|
16
|
$have == $want || botch_array_length($have, $want); |
1014
|
3
|
|
|
3
|
|
785
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
14
|
|
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
sub assert_array_length_min( \@ $ ) |
1017
|
|
|
|
|
|
|
:Assert( qw[array] ) |
1018
|
|
|
|
|
|
|
{ |
1019
|
11
|
|
|
11
|
1
|
1675
|
my($aref, $want) = @_; |
1020
|
11
|
|
|
|
|
45
|
assert_arrayref($aref); |
1021
|
11
|
|
|
|
|
35
|
assert_whole_number($want); |
1022
|
11
|
|
|
|
|
27
|
my $have = @$aref; |
1023
|
11
|
100
|
|
|
|
72
|
$have >= $want || botch_array_length($have, "$want or more"); |
1024
|
3
|
|
|
3
|
|
792
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
sub assert_array_length_max( \@ $ ) |
1027
|
|
|
|
|
|
|
:Assert( qw[array] ) |
1028
|
|
|
|
|
|
|
{ |
1029
|
2
|
|
|
2
|
1
|
1657
|
my($aref, $want) = @_; |
1030
|
2
|
|
|
|
|
8
|
assert_arrayref($aref); |
1031
|
2
|
|
|
|
|
14
|
assert_whole_number($want); |
1032
|
2
|
|
|
|
|
8
|
my $have = @$aref; |
1033
|
2
|
100
|
|
|
|
19
|
$have <= $want || botch_array_length($have, "$want or fewer"); |
1034
|
3
|
|
|
3
|
|
708
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
11
|
|
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
sub assert_array_length_minmax( \@ $$) |
1037
|
|
|
|
|
|
|
:Assert( qw[array] ) |
1038
|
|
|
|
|
|
|
{ |
1039
|
6
|
|
|
6
|
1
|
4234
|
my($aref, $low, $high) = @_; |
1040
|
6
|
|
|
|
|
16
|
my $have = @$aref; |
1041
|
6
|
|
|
|
|
24
|
assert_whole_number($_) for $low, $high; |
1042
|
4
|
100
|
100
|
|
|
45
|
$have >= $low && $have <= $high |
1043
|
|
|
|
|
|
|
|| botch_array_length($have, "between $low and $high"); |
1044
|
3
|
|
|
3
|
|
743
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
15
|
|
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
sub assert_argc(;$) |
1047
|
|
|
|
|
|
|
:Assert( qw[argc] ) |
1048
|
|
|
|
|
|
|
{ |
1049
|
6
|
100
|
|
6
|
1
|
5476
|
unless (@_) { |
1050
|
2
|
100
|
|
|
|
11
|
his_args || botch_argc(0, "at least 1"); |
1051
|
1
|
|
|
|
|
7
|
return; |
1052
|
|
|
|
|
|
|
} |
1053
|
4
|
|
|
|
|
17
|
&assert_whole_number; |
1054
|
4
|
|
|
|
|
31
|
my($want) = @_; |
1055
|
4
|
|
|
|
|
16
|
my $have = his_args; |
1056
|
4
|
100
|
|
|
|
23
|
$have == $want || botch_argc($have, $want); |
1057
|
3
|
|
|
3
|
|
741
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
sub assert_argc_min($) |
1060
|
|
|
|
|
|
|
:Assert( qw[argc] ) |
1061
|
|
|
|
|
|
|
{ |
1062
|
2
|
|
|
2
|
1
|
2217
|
&assert_whole_number; |
1063
|
2
|
|
|
|
|
28
|
my($want) = @_; |
1064
|
2
|
|
|
|
|
13
|
my $have = his_args; |
1065
|
2
|
100
|
|
|
|
16
|
$have >= $want || botch_argc($have, "$want or more"); |
1066
|
3
|
|
|
3
|
|
612
|
} |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
13
|
|
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
sub assert_argc_max($) |
1069
|
|
|
|
|
|
|
:Assert( qw[argc] ) |
1070
|
|
|
|
|
|
|
{ |
1071
|
4
|
|
|
4
|
1
|
3507
|
&assert_whole_number; |
1072
|
4
|
|
|
|
|
15
|
my($want) = @_; |
1073
|
4
|
|
|
|
|
20
|
my $have = his_args; |
1074
|
4
|
100
|
|
|
|
28
|
$have <= $want || botch_argc($have, "$want or fewer"); |
1075
|
3
|
|
|
3
|
|
648
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
sub assert_argc_minmax($$) |
1078
|
|
|
|
|
|
|
:Assert( qw[argc] ) |
1079
|
|
|
|
|
|
|
{ |
1080
|
5
|
|
|
5
|
1
|
3672
|
assert_whole_number($_) for my($low, $high) = @_; |
1081
|
5
|
|
|
|
|
18
|
my $have = his_args; |
1082
|
5
|
100
|
100
|
|
|
56
|
$have >= $low && $have <= $high |
1083
|
|
|
|
|
|
|
|| botch_argc($have, "between $low and $high"); |
1084
|
3
|
|
|
3
|
|
878
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
15
|
|
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
sub assert_hash_nonempty(\%) |
1087
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1088
|
|
|
|
|
|
|
{ |
1089
|
2
|
|
|
2
|
1
|
1712
|
&assert_hashref_nonempty; |
1090
|
3
|
|
|
3
|
|
499
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
sub assert_hashref_nonempty($) |
1093
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1094
|
|
|
|
|
|
|
{ |
1095
|
4
|
|
|
4
|
1
|
1712
|
&assert_hashref; |
1096
|
4
|
|
|
|
|
8
|
my($href) = @_; |
1097
|
4
|
100
|
|
|
|
20
|
%$href || botch "hash is empty"; |
1098
|
3
|
|
|
3
|
|
616
|
} |
|
3
|
|
|
|
|
40
|
|
|
3
|
|
|
|
|
15
|
|
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
sub assert_hash_keys(\% @) |
1101
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1102
|
|
|
|
|
|
|
{ |
1103
|
2
|
|
|
2
|
1
|
1718
|
&assert_hashref_keys; |
1104
|
3
|
|
|
3
|
|
500
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
sub assert_hash_keys_required(\% @) |
1107
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1108
|
|
|
|
|
|
|
{ |
1109
|
4
|
|
|
4
|
1
|
3665
|
&assert_hashref_keys_required; |
1110
|
3
|
|
|
3
|
|
503
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
sub assert_hash_keys_allowed(\% @) |
1113
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1114
|
|
|
|
|
|
|
{ |
1115
|
5
|
|
|
5
|
1
|
3917
|
&assert_hashref_keys_allowed; |
1116
|
3
|
|
|
3
|
|
497
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
sub assert_hash_keys_required_and_allowed(\% $ $) |
1119
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1120
|
|
|
|
|
|
|
{ |
1121
|
4
|
|
|
4
|
1
|
3281
|
&assert_hashref_keys_required_and_allowed; |
1122
|
3
|
|
|
3
|
|
506
|
} |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
15
|
|
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
sub assert_hash_keys_allowed_and_required(\% $ $) |
1125
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1126
|
|
|
|
|
|
|
{ |
1127
|
4
|
|
|
4
|
1
|
3345
|
&assert_hashref_keys_allowed_and_required; |
1128
|
3
|
|
|
3
|
|
500
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
sub assert_hashref_keys($@) |
1131
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1132
|
|
|
|
|
|
|
{ |
1133
|
4
|
|
|
4
|
1
|
1831
|
&assert_hashref_keys_required; |
1134
|
3
|
|
|
3
|
|
486
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
sub assert_hashref_keys_required($@) |
1137
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1138
|
|
|
|
|
|
|
{ |
1139
|
14
|
|
|
14
|
1
|
4929
|
my($hashref, @keylist) = @_; |
1140
|
14
|
|
|
|
|
55
|
assert_min_keys($hashref, @keylist); |
1141
|
3
|
|
|
3
|
|
556
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
sub assert_hashref_keys_allowed($@) |
1144
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1145
|
|
|
|
|
|
|
{ |
1146
|
11
|
|
|
11
|
1
|
4920
|
my($hashref, @keylist) = @_; |
1147
|
11
|
|
|
|
|
48
|
assert_max_keys($hashref, @keylist); |
1148
|
3
|
|
|
3
|
|
570
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
15
|
|
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
sub _promote_to_typeref($$) { |
1151
|
169
|
|
|
169
|
|
322
|
my(undef, $type) = @_; |
1152
|
169
|
|
|
|
|
358
|
&assert_anyref; |
1153
|
169
|
100
|
50
|
|
|
940
|
$_[0] = ${ $_[0] } if (reftype($_[0]) // "") =~ /^ (?: SCALAR | REF ) \z/x; |
|
116
|
|
|
|
|
241
|
|
1154
|
169
|
|
|
|
|
378
|
assert_reftype($type, $_[0]); |
1155
|
|
|
|
|
|
|
} |
1156
|
|
|
|
|
|
|
|
1157
|
111
|
|
|
111
|
|
289
|
sub _promote_to_hashref ($) { _promote_to_typeref($_[0], "HASH") } |
1158
|
58
|
|
|
58
|
|
105
|
sub _promote_to_arrayref($) { _promote_to_typeref($_[0], "ARRAY") } |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
sub assert_min_keys( \[%$] @ ) |
1161
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1162
|
|
|
|
|
|
|
{ |
1163
|
25
|
|
|
25
|
1
|
8882
|
my($hashref, @keylist) = @_; |
1164
|
25
|
|
|
|
|
83
|
_promote_to_hashref($hashref); |
1165
|
24
|
100
|
|
|
|
79
|
@keylist || botch "no min keys given"; |
1166
|
|
|
|
|
|
|
|
1167
|
22
|
|
|
|
|
50
|
my @missing = grep { !exists $hashref->{$_} } @keylist; |
|
75
|
|
|
|
|
180
|
|
1168
|
22
|
100
|
|
|
|
68
|
return unless @missing; |
1169
|
|
|
|
|
|
|
|
1170
|
13
|
|
100
|
|
|
123
|
my $message = "key" . (@missing > 1 && "s") . " " |
1171
|
|
|
|
|
|
|
. quotify_and(uca_sort @missing) |
1172
|
|
|
|
|
|
|
. " missing from hash"; |
1173
|
|
|
|
|
|
|
|
1174
|
13
|
|
|
|
|
47
|
botch $message; |
1175
|
3
|
|
|
3
|
|
1517
|
} |
|
3
|
|
|
|
|
21
|
|
|
3
|
|
|
|
|
16
|
|
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
sub assert_max_keys( \[%$] @ ) |
1178
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1179
|
|
|
|
|
|
|
{ |
1180
|
20
|
|
|
20
|
1
|
7398
|
my($hashref, @keylist) = @_; |
1181
|
20
|
|
|
|
|
59
|
_promote_to_hashref($hashref); |
1182
|
19
|
|
|
|
|
59
|
my %allowed = map { $_ => 1 } @keylist; |
|
64
|
|
|
|
|
184
|
|
1183
|
19
|
|
|
|
|
41
|
my @forbidden; |
1184
|
19
|
|
|
|
|
108
|
for my $key (keys %$hashref) { |
1185
|
57
|
100
|
|
|
|
149
|
delete $allowed{$key} || push @forbidden, $key; |
1186
|
|
|
|
|
|
|
} |
1187
|
19
|
100
|
|
|
|
67
|
return unless @forbidden; |
1188
|
|
|
|
|
|
|
|
1189
|
12
|
|
100
|
|
|
93
|
my $message = "key" . (@forbidden > 1 && "s") . " " |
1190
|
|
|
|
|
|
|
. quotify_and(uca_sort @forbidden) |
1191
|
|
|
|
|
|
|
. " forbidden in hash"; |
1192
|
|
|
|
|
|
|
|
1193
|
12
|
|
|
|
|
56
|
botch $message; |
1194
|
3
|
|
|
3
|
|
917
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
16
|
|
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
sub assert_minmax_keys( \[%$] \[@$] \[@$] ) |
1197
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1198
|
|
|
|
|
|
|
{ |
1199
|
32
|
|
|
32
|
1
|
4597
|
my($hashref, $minkeys, $maxkeys) = @_; |
1200
|
32
|
|
|
|
|
83
|
_promote_to_hashref($hashref); |
1201
|
32
|
|
|
|
|
96
|
_promote_to_arrayref($minkeys); |
1202
|
32
|
100
|
|
|
|
85
|
@$minkeys || botch "no min keys given"; |
1203
|
26
|
|
|
|
|
56
|
_promote_to_arrayref($maxkeys); |
1204
|
26
|
100
|
|
|
|
61
|
@$maxkeys || botch "no max keys given"; |
1205
|
|
|
|
|
|
|
|
1206
|
24
|
|
|
|
|
32
|
my @forbidden; |
1207
|
24
|
|
|
|
|
52
|
my %required = map { $_ => 1 } @$minkeys; |
|
74
|
|
|
|
|
208
|
|
1208
|
24
|
|
|
|
|
53
|
my %allowed = map { $_ => 1 } @$maxkeys; |
|
80
|
|
|
|
|
144
|
|
1209
|
|
|
|
|
|
|
|
1210
|
24
|
|
|
|
|
89
|
for my $key (keys %$hashref) { |
1211
|
72
|
|
|
|
|
109
|
delete $required{$key}; |
1212
|
72
|
100
|
|
|
|
162
|
delete $allowed{$key} || push @forbidden, $key; |
1213
|
|
|
|
|
|
|
} |
1214
|
24
|
|
|
|
|
57
|
my @missing = keys %required; |
1215
|
|
|
|
|
|
|
|
1216
|
24
|
100
|
100
|
|
|
140
|
return unless @missing || @forbidden; |
1217
|
|
|
|
|
|
|
|
1218
|
12
|
100
|
100
|
|
|
82
|
my $missing_msg = !@missing ? "" : |
1219
|
|
|
|
|
|
|
"key" . (@missing > 1 && "s") . " " |
1220
|
|
|
|
|
|
|
. quotify_and(uca_sort @missing) |
1221
|
|
|
|
|
|
|
. " missing from hash"; |
1222
|
|
|
|
|
|
|
|
1223
|
12
|
100
|
100
|
|
|
93
|
my $forbidden_msg = !@forbidden ? "" : |
1224
|
|
|
|
|
|
|
"key" . (@forbidden > 1 && "s") . " " |
1225
|
|
|
|
|
|
|
. quotify_and(uca_sort @forbidden) |
1226
|
|
|
|
|
|
|
. " forbidden in hash"; |
1227
|
|
|
|
|
|
|
|
1228
|
12
|
|
|
|
|
31
|
my $message = commify_and grep { length } $missing_msg, $forbidden_msg; |
|
24
|
|
|
|
|
56
|
|
1229
|
12
|
|
|
|
|
40
|
botch $message; |
1230
|
3
|
|
|
3
|
|
1411
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
14
|
|
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
sub assert_keys( \[%$] @ ) |
1233
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1234
|
|
|
|
|
|
|
{ |
1235
|
12
|
|
|
12
|
1
|
10011
|
my($hashref, @keylist) = @_; |
1236
|
12
|
|
|
|
|
46
|
_promote_to_hashref($hashref); |
1237
|
12
|
|
|
|
|
49
|
assert_minmax_keys($hashref, @keylist, @keylist); |
1238
|
3
|
|
|
3
|
|
627
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
17
|
|
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
sub assert_hashref_keys_required_and_allowed($$$) |
1241
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1242
|
|
|
|
|
|
|
{ |
1243
|
8
|
|
|
8
|
1
|
3654
|
my($hashref, $required, $allowed) = @_; |
1244
|
8
|
|
|
|
|
27
|
assert_minmax_keys($hashref, $required, $allowed); |
1245
|
3
|
|
|
3
|
|
606
|
} |
|
3
|
|
|
|
|
22
|
|
|
3
|
|
|
|
|
13
|
|
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
sub assert_hashref_keys_allowed_and_required($$$) |
1248
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1249
|
|
|
|
|
|
|
{ |
1250
|
7
|
|
|
7
|
1
|
3366
|
my($hashref, $allowed, $required) = @_; |
1251
|
7
|
|
|
|
|
22
|
assert_minmax_keys($hashref, $required, $allowed); |
1252
|
3
|
|
|
3
|
|
579
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
# From perl5180delta, you couldn't actually get any use of |
1256
|
|
|
|
|
|
|
# the predicates to check whether a hash or hashref was |
1257
|
|
|
|
|
|
|
# locked because even though they were exported those |
1258
|
|
|
|
|
|
|
# function did not exist before.! |
1259
|
|
|
|
|
|
|
## |
1260
|
|
|
|
|
|
|
## * Hash::Util has been upgraded to 0.15. |
1261
|
|
|
|
|
|
|
## |
1262
|
|
|
|
|
|
|
## "hash_unlocked" and "hashref_unlocked" now returns true if the hash |
1263
|
|
|
|
|
|
|
## is unlocked, instead of always returning false [perl #112126]. |
1264
|
|
|
|
|
|
|
## |
1265
|
|
|
|
|
|
|
## "hash_unlocked", "hashref_unlocked", "lock_hash_recurse" and |
1266
|
|
|
|
|
|
|
## "unlock_hash_recurse" are now exportable [perl #112126]. |
1267
|
|
|
|
|
|
|
## |
1268
|
|
|
|
|
|
|
## Two new functions, "hash_locked" and "hashref_locked", have been |
1269
|
|
|
|
|
|
|
## added. Oddly enough, these two functions were already exported, |
1270
|
|
|
|
|
|
|
## even though they did not exist [perl #112126]. |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
BEGIN { |
1273
|
3
|
|
|
3
|
|
1831
|
use Hash::Util qw{hash_locked}; |
|
3
|
|
|
|
|
6445
|
|
|
3
|
|
|
|
|
23
|
|
1274
|
|
|
|
|
|
|
|
1275
|
3
|
|
|
3
|
|
747
|
my $want_version = 0.15; |
1276
|
3
|
|
|
|
|
46
|
my $have_version = Hash::Util->VERSION; |
1277
|
3
|
|
|
|
|
15
|
my $huv = "v$have_version of Hash::Util and we need"; |
1278
|
3
|
|
|
|
|
218
|
my $compiling = "compiling assert_lock and assert_unlocked because your perl $^V has"; |
1279
|
3
|
|
33
|
|
|
27
|
my $debugging = $Exporter::Verbose || $Assert_Debug; |
1280
|
|
|
|
|
|
|
|
1281
|
3
|
50
|
|
|
|
25
|
if ($have_version < $want_version) { |
1282
|
0
|
0
|
|
|
|
0
|
carp "Not $compiling only $huv v$want_version at ", __FILE__, " line ", __LINE__ if $debugging; |
1283
|
|
|
|
|
|
|
} else { |
1284
|
3
|
50
|
|
|
|
11
|
carp "\u$compiling $huv only v$want_version at ", __FILE__, " line ", __LINE__ if $debugging; |
1285
|
|
|
|
|
|
|
|
1286
|
3
|
50
|
|
3
|
1
|
480
|
confess "compilation eval blew up: $@" unless eval <<'END_OF_LOCK_STUFF'; |
|
3
|
100
|
|
3
|
1
|
25
|
|
|
3
|
100
|
|
11
|
|
7
|
|
|
3
|
|
|
11
|
|
16
|
|
|
11
|
|
|
|
|
9206
|
|
|
11
|
|
|
|
|
49
|
|
|
11
|
|
|
|
|
52
|
|
|
3
|
|
|
|
|
657
|
|
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
9597
|
|
|
11
|
|
|
|
|
47
|
|
|
11
|
|
|
|
|
81
|
|
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
sub assert_locked( \[%$] @ ) |
1289
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1290
|
|
|
|
|
|
|
{ |
1291
|
|
|
|
|
|
|
my($hashref) = @_; |
1292
|
|
|
|
|
|
|
_promote_to_hashref($hashref); |
1293
|
|
|
|
|
|
|
hash_locked(%$hashref) || botch "hash is locked"; |
1294
|
|
|
|
|
|
|
} |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
sub assert_unlocked( \[%$] @ ) |
1297
|
|
|
|
|
|
|
:Assert( qw[hash] ) |
1298
|
|
|
|
|
|
|
{ |
1299
|
|
|
|
|
|
|
my($hashref) = @_; |
1300
|
|
|
|
|
|
|
_promote_to_hashref($hashref); |
1301
|
|
|
|
|
|
|
!hash_locked(%$hashref) || botch "hash is not locked"; |
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
1; |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
END_OF_LOCK_STUFF |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
} |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
sub assert_anyref($) |
1311
|
|
|
|
|
|
|
:Assert( qw[ref] ) |
1312
|
|
|
|
|
|
|
{ |
1313
|
295
|
|
|
295
|
1
|
24085
|
my($arg) = @_; |
1314
|
295
|
100
|
|
|
|
916
|
ref($arg) || botch "expected reference argument"; |
1315
|
3
|
|
|
3
|
|
21
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
sub assert_nonref($) |
1318
|
|
|
|
|
|
|
:Assert( qw[ref] ) |
1319
|
|
|
|
|
|
|
{ |
1320
|
425
|
|
|
425
|
1
|
795
|
my($arg) = @_; |
1321
|
425
|
100
|
|
|
|
1026
|
!ref($arg) || botch "expected nonreference argument"; |
1322
|
3
|
|
|
3
|
|
619
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
sub assert_reftype($$) |
1325
|
|
|
|
|
|
|
:Assert( qw[object ref] ) |
1326
|
|
|
|
|
|
|
{ |
1327
|
325
|
|
|
325
|
1
|
28577
|
my($want_type, $arg) = @_; |
1328
|
325
|
|
100
|
|
|
1152
|
my $have_type = reftype($arg) // "non-reference"; |
1329
|
325
|
100
|
|
|
|
1454
|
$have_type eq $want_type || botch "expected reftype of $want_type not $have_type"; |
1330
|
3
|
|
|
3
|
|
616
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
sub assert_globref($) |
1333
|
|
|
|
|
|
|
:Assert( qw[glob ref] ) |
1334
|
|
|
|
|
|
|
{ |
1335
|
17
|
|
|
17
|
1
|
1732
|
my($arg) = @_; |
1336
|
17
|
|
|
|
|
54
|
assert_reftype(GLOB => $arg); |
1337
|
3
|
|
|
3
|
|
620
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
16
|
|
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
sub assert_ioref($) |
1340
|
|
|
|
|
|
|
:Assert( qw[io ref] ) |
1341
|
|
|
|
|
|
|
{ |
1342
|
1
|
|
|
1
|
1
|
1075
|
my($arg) = @_; |
1343
|
1
|
|
|
|
|
8
|
assert_reftype(IO => $arg); |
1344
|
3
|
|
|
3
|
|
554
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
14
|
|
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
sub assert_coderef($) |
1347
|
|
|
|
|
|
|
:Assert( qw[code ref] ) |
1348
|
|
|
|
|
|
|
{ |
1349
|
6
|
|
|
6
|
1
|
2101
|
my($arg) = @_; |
1350
|
6
|
|
|
|
|
24
|
assert_reftype(CODE => $arg); |
1351
|
3
|
|
|
3
|
|
534
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
sub assert_hashref($) |
1354
|
|
|
|
|
|
|
:Assert( qw[hash ref] ) |
1355
|
|
|
|
|
|
|
{ |
1356
|
31
|
|
|
31
|
1
|
8561
|
my($arg) = @_; |
1357
|
31
|
|
|
|
|
98
|
assert_reftype(HASH => $arg); |
1358
|
3
|
|
|
3
|
|
533
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
11
|
|
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
sub assert_arrayref($) |
1361
|
|
|
|
|
|
|
:Assert( qw[array ref] ) |
1362
|
|
|
|
|
|
|
{ |
1363
|
40
|
|
|
40
|
1
|
6224
|
my($arg) = @_; |
1364
|
40
|
|
|
|
|
132
|
assert_reftype(ARRAY => $arg); |
1365
|
3
|
|
|
3
|
|
549
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
15
|
|
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
sub assert_refref($) |
1368
|
|
|
|
|
|
|
:Assert( qw[ref] ) |
1369
|
|
|
|
|
|
|
{ |
1370
|
3
|
|
|
3
|
1
|
2776
|
my($arg) = @_; |
1371
|
3
|
|
|
|
|
13
|
assert_reftype(REF => $arg); |
1372
|
3
|
|
|
3
|
|
529
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
sub assert_scalarref($) |
1375
|
|
|
|
|
|
|
:Assert( qw[scalar ref] ) |
1376
|
|
|
|
|
|
|
{ |
1377
|
24
|
|
|
24
|
1
|
6557
|
my($arg) = @_; |
1378
|
24
|
|
|
|
|
83
|
assert_reftype(SCALAR => $arg); |
1379
|
3
|
|
|
3
|
|
580
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
13
|
|
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
sub assert_unblessed_ref($) |
1382
|
|
|
|
|
|
|
:Assert( qw[ref object] ) |
1383
|
|
|
|
|
|
|
{ |
1384
|
20
|
|
|
20
|
1
|
19300
|
&assert_anyref; |
1385
|
19
|
|
|
|
|
47
|
&assert_nonobject; |
1386
|
3
|
|
|
3
|
|
511
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
19
|
|
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
sub assert_method() |
1389
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1390
|
|
|
|
|
|
|
{ |
1391
|
3
|
|
|
3
|
1
|
2668
|
my $argc = his_args; |
1392
|
3
|
100
|
|
|
|
29
|
$argc >= 1 || botch "invocant missing from method invoked as subroutine"; |
1393
|
3
|
|
|
3
|
|
538
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
15
|
|
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
sub assert_object_method() |
1396
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1397
|
|
|
|
|
|
|
{ |
1398
|
4
|
|
|
4
|
1
|
2643
|
my $argc = his_args; |
1399
|
4
|
100
|
|
|
|
19
|
$argc >= 1 || botch "no invocant found"; |
1400
|
3
|
|
|
|
|
11
|
my($self) = his_args; |
1401
|
3
|
100
|
|
|
|
18
|
blessed($self) || botch "object method invoked as class method"; |
1402
|
3
|
|
|
3
|
|
610
|
} |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
12
|
|
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
sub assert_class_method() |
1405
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1406
|
|
|
|
|
|
|
{ |
1407
|
3
|
|
|
3
|
1
|
2246
|
my $argc = his_args; |
1408
|
3
|
100
|
|
|
|
18
|
$argc >= 1 || botch "no invocant found"; |
1409
|
2
|
|
|
|
|
7
|
my($class) = his_args; |
1410
|
2
|
100
|
|
|
|
19
|
!blessed($class) || botch "class method invoked as object method"; |
1411
|
3
|
|
|
3
|
|
696
|
} |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
15
|
|
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
# This one is a no-op! |
1414
|
|
|
|
|
|
|
sub assert_public_method() |
1415
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1416
|
|
|
|
|
|
|
{ |
1417
|
3
|
|
|
3
|
1
|
4397
|
my $argc = his_args; |
1418
|
3
|
100
|
|
|
|
17
|
$argc >= 1 || botch "invocant missing from public method invoked as subroutine"; |
1419
|
3
|
|
|
3
|
|
538
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
17
|
|
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
my %skip_caller = map { $_ => 1 } qw( |
1422
|
|
|
|
|
|
|
Class::MOP::Method::Wrapped |
1423
|
|
|
|
|
|
|
Moose::Meta::Method::Augmented |
1424
|
|
|
|
|
|
|
); |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
# And this one isn't *all* that hard... relatively speaking. |
1427
|
|
|
|
|
|
|
sub assert_private_method() |
1428
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1429
|
|
|
|
|
|
|
{ |
1430
|
19
|
|
|
19
|
1
|
4942
|
my $argc = his_args; |
1431
|
19
|
100
|
|
|
|
42
|
$argc >= 1 || botch "invocant missing from private method invoked as subroutine"; |
1432
|
|
|
|
|
|
|
|
1433
|
18
|
|
|
|
|
22
|
my $frame = 0; |
1434
|
18
|
|
|
|
|
74
|
my @to = caller $frame++; |
1435
|
|
|
|
|
|
|
|
1436
|
18
|
|
|
|
|
70
|
my @from = caller $frame++; |
1437
|
18
|
|
66
|
|
|
72
|
while (@from && $skip_caller{ $from[CALLER_PACKAGE] }) { |
1438
|
36
|
|
|
|
|
225
|
@from = caller $frame++; |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
18
|
|
|
|
|
33
|
my $msg = "private sub &$from[CALLER_SUBROUTINE] called from"; |
1442
|
18
|
50
|
|
|
|
34
|
@from || botch "ran out of stack while inspecting $msg"; |
1443
|
|
|
|
|
|
|
|
1444
|
18
|
|
|
|
|
18
|
my @botches; |
1445
|
|
|
|
|
|
|
|
1446
|
18
|
100
|
|
|
|
31
|
$from[CALLER_PACKAGE] eq $to[CALLER_PACKAGE] |
1447
|
|
|
|
|
|
|
|| push @botches, "alien package $from[CALLER_PACKAGE]" ; |
1448
|
|
|
|
|
|
|
|
1449
|
18
|
100
|
|
|
|
30
|
$from[CALLER_FILENAME] eq $to[CALLER_FILENAME] |
1450
|
|
|
|
|
|
|
|| push @botches, "alien file $from[CALLER_FILENAME] line $from[CALLER_LINE]"; |
1451
|
|
|
|
|
|
|
|
1452
|
18
|
100
|
|
|
|
67
|
@botches == 0 |
1453
|
|
|
|
|
|
|
|| botch "$msg " . join(" at " => @botches); |
1454
|
|
|
|
|
|
|
|
1455
|
3
|
|
|
3
|
|
1580
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
19
|
|
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
# But this one? This one is RIDICULOUS. O Moose how we hates you |
1458
|
|
|
|
|
|
|
# foreverz for ruining perl's simple inheritance model and its export |
1459
|
|
|
|
|
|
|
# model and its import model and its package model till the end of time! |
1460
|
|
|
|
|
|
|
sub assert_protected_method() |
1461
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1462
|
|
|
|
|
|
|
{ |
1463
|
5
|
|
|
5
|
1
|
2529
|
my $argc = his_args; |
1464
|
5
|
100
|
|
|
|
23
|
$argc >= 1 || botch "invocant missing from protected method invoked as subroutine"; |
1465
|
|
|
|
|
|
|
|
1466
|
4
|
|
|
|
|
5
|
my $self; # sic, no assignment |
1467
|
4
|
|
|
|
|
6
|
my $frame = 0; |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
my $next_frame = sub { |
1470
|
|
|
|
|
|
|
package DB; |
1471
|
8
|
|
|
8
|
|
9
|
our @args; |
1472
|
8
|
|
|
|
|
42
|
my @frame = caller(1 + $frame++); |
1473
|
8
|
|
100
|
|
|
27
|
$self = $args[0] // "undef"; |
1474
|
8
|
50
|
66
|
|
|
34
|
$self = "undef" if ref $self && !Scalar::Util::blessed($self); |
1475
|
8
|
|
|
|
|
27
|
return @frame; |
1476
|
4
|
|
|
|
|
15
|
}; |
1477
|
|
|
|
|
|
|
|
1478
|
4
|
|
|
|
|
9
|
my @to = $next_frame->(); |
1479
|
4
|
|
|
|
|
10
|
my @from = $next_frame->(); |
1480
|
4
|
|
33
|
|
|
18
|
while (@from && $skip_caller{ $from[CALLER_PACKAGE] }) { |
1481
|
0
|
|
|
|
|
0
|
@from = $next_frame->(); |
1482
|
|
|
|
|
|
|
} |
1483
|
|
|
|
|
|
|
|
1484
|
4
|
|
|
|
|
8
|
my $msg = "protected sub &$from[CALLER_SUBROUTINE]"; |
1485
|
4
|
50
|
|
|
|
9
|
@from || botch "ran out of stack while inspecting $msg"; |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
( |
1488
|
4
|
100
|
100
|
|
|
143
|
$from[CALLER_PACKAGE] |
1489
|
|
|
|
|
|
|
->isa( $to[CALLER_PACKAGE] ) |
1490
|
|
|
|
|
|
|
|| $self->DOES( $from[CALLER_PACKAGE] ) |
1491
|
|
|
|
|
|
|
) || botch join " " => ($msg, |
1492
|
|
|
|
|
|
|
"called from unfriendly package" |
1493
|
|
|
|
|
|
|
=> $from[CALLER_PACKAGE], |
1494
|
|
|
|
|
|
|
at => $from[CALLER_FILENAME], |
1495
|
|
|
|
|
|
|
line => $from[CALLER_LINE] |
1496
|
|
|
|
|
|
|
); |
1497
|
|
|
|
|
|
|
|
1498
|
3
|
|
|
3
|
|
1316
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
16
|
|
1499
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
sub assert_known_package($) |
1501
|
|
|
|
|
|
|
:Assert( qw[object ident] ) |
1502
|
|
|
|
|
|
|
{ |
1503
|
28
|
|
|
28
|
1
|
3295
|
&assert_nonempty; |
1504
|
16
|
|
|
|
|
31
|
my($arg) = @_; |
1505
|
3
|
|
|
3
|
|
532
|
my $stash = do { no strict "refs"; \%{ $arg . "::" } }; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
156
|
|
|
16
|
|
|
|
|
32
|
|
|
16
|
|
|
|
|
25
|
|
|
16
|
|
|
|
|
86
|
|
1506
|
3
|
|
|
3
|
|
19
|
no overloading; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
288
|
|
1507
|
16
|
100
|
|
|
|
60
|
%$stash || botch "unknown package $arg"; |
1508
|
3
|
|
|
3
|
|
23
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
15
|
|
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
sub assert_object($) |
1511
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1512
|
|
|
|
|
|
|
{ |
1513
|
3
|
|
|
3
|
|
463
|
no overloading; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
247
|
|
1514
|
46
|
|
|
46
|
1
|
2831
|
&assert_anyref; |
1515
|
34
|
|
|
|
|
62
|
my($arg) = @_; |
1516
|
34
|
100
|
|
|
|
155
|
blessed($arg) || botch "expected blessed referent not $arg"; |
1517
|
3
|
|
|
3
|
|
22
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
sub assert_nonobject($) |
1520
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1521
|
|
|
|
|
|
|
{ |
1522
|
3
|
|
|
3
|
|
446
|
no overloading; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
224
|
|
1523
|
23
|
|
|
23
|
1
|
3376
|
my($arg) = @_; |
1524
|
23
|
100
|
|
|
|
121
|
!blessed($arg) || botch "expected unblessed referent not $arg"; |
1525
|
3
|
|
|
3
|
|
19
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
12
|
|
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
sub _get_invocant_type($) { |
1528
|
92
|
|
|
92
|
|
185
|
my($invocant) = @_; |
1529
|
92
|
|
|
|
|
147
|
my $type; |
1530
|
92
|
100
|
|
|
|
338
|
if (blessed $invocant) { |
1531
|
46
|
|
|
|
|
121
|
$type = "object"; |
1532
|
|
|
|
|
|
|
} else { |
1533
|
46
|
|
|
|
|
103
|
$type = "package"; |
1534
|
|
|
|
|
|
|
} |
1535
|
92
|
|
|
|
|
212
|
return $type; |
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
|
1538
|
|
|
|
|
|
|
sub assert_can($@) |
1539
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1540
|
|
|
|
|
|
|
{ |
1541
|
3
|
|
|
3
|
|
691
|
no overloading; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
555
|
|
1542
|
26
|
|
|
26
|
1
|
13087
|
my($invocant, @methods) = @_; |
1543
|
26
|
100
|
|
|
|
84
|
@methods || botch "need one or more methods to check against"; |
1544
|
25
|
|
|
|
|
81
|
my $type = _get_invocant_type $invocant; |
1545
|
25
|
|
|
|
|
60
|
my @cant = grep { !$invocant->can($_) } @methods; |
|
53
|
|
|
|
|
415
|
|
1546
|
25
|
100
|
|
|
|
102
|
return unless @cant; |
1547
|
|
|
|
|
|
|
|
1548
|
8
|
|
100
|
|
|
67
|
my $message = "cannot invoke method" |
1549
|
|
|
|
|
|
|
. (@cant > 1 && "s") . " " |
1550
|
|
|
|
|
|
|
. quotify_or(uca_sort @cant) |
1551
|
|
|
|
|
|
|
. " on $type $invocant"; |
1552
|
|
|
|
|
|
|
|
1553
|
8
|
|
|
|
|
29
|
botch $message; |
1554
|
3
|
|
|
3
|
|
23
|
} |
|
3
|
|
|
|
|
17
|
|
|
3
|
|
|
|
|
15
|
|
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
sub assert_cant($@) |
1557
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1558
|
|
|
|
|
|
|
{ |
1559
|
3
|
|
|
3
|
|
515
|
no overloading; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
554
|
|
1560
|
13
|
|
|
13
|
1
|
8507
|
my($invocant, @methods) = @_; |
1561
|
13
|
100
|
|
|
|
52
|
@methods || botch "need one or more methods to check against"; |
1562
|
12
|
|
|
|
|
33
|
my $type = _get_invocant_type $invocant; |
1563
|
12
|
|
|
|
|
29
|
my @can = grep { $invocant->can($_) } @methods; |
|
16
|
|
|
|
|
171
|
|
1564
|
12
|
100
|
|
|
|
45
|
return unless @can; |
1565
|
|
|
|
|
|
|
|
1566
|
5
|
|
100
|
|
|
52
|
my $message = "should not be able to invoke method" |
1567
|
|
|
|
|
|
|
. (@can > 1 && "s") . " " |
1568
|
|
|
|
|
|
|
. quotify_or(uca_sort @can) |
1569
|
|
|
|
|
|
|
. " on $type $invocant"; |
1570
|
|
|
|
|
|
|
|
1571
|
5
|
|
|
|
|
28
|
botch $message; |
1572
|
3
|
|
|
3
|
|
24
|
} |
|
3
|
|
|
|
|
15
|
|
|
3
|
|
|
|
|
16
|
|
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
sub assert_object_can($@) |
1575
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1576
|
|
|
|
|
|
|
{ |
1577
|
10
|
|
|
10
|
1
|
8440
|
my($instance, @methods) = @_; |
1578
|
10
|
|
|
|
|
37
|
assert_object($instance); |
1579
|
7
|
|
|
|
|
26
|
assert_can($instance, @methods); |
1580
|
3
|
|
|
3
|
|
610
|
} |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
14
|
|
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
sub assert_object_cant($@) |
1583
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1584
|
|
|
|
|
|
|
{ |
1585
|
2
|
|
|
2
|
1
|
1748
|
my($instance, @methods) = @_; |
1586
|
2
|
|
|
|
|
11
|
assert_object($instance); |
1587
|
2
|
|
|
|
|
14
|
assert_cant($instance, @methods); |
1588
|
3
|
|
|
3
|
|
592
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
16
|
|
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
sub assert_class_can($@) |
1591
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1592
|
|
|
|
|
|
|
{ |
1593
|
8
|
|
|
8
|
1
|
6501
|
my($class, @methods) = @_; |
1594
|
8
|
|
|
|
|
37
|
assert_known_package($class); |
1595
|
3
|
|
|
|
|
7
|
assert_can($class, @methods); |
1596
|
3
|
|
|
3
|
|
583
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
14
|
|
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
sub assert_class_cant($@) |
1599
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1600
|
|
|
|
|
|
|
{ |
1601
|
1
|
|
|
1
|
1
|
666
|
my($class, @methods) = @_; |
1602
|
1
|
|
|
|
|
5
|
assert_known_package($class); |
1603
|
1
|
|
|
|
|
4
|
assert_cant($class, @methods); |
1604
|
3
|
|
|
3
|
|
566
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
sub assert_isa($@) |
1607
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1608
|
|
|
|
|
|
|
{ |
1609
|
38
|
|
|
38
|
1
|
13104
|
my($subclass, @superclasses) = @_; |
1610
|
38
|
100
|
|
|
|
116
|
@superclasses || botch "needs one or more superclasses to check against"; |
1611
|
37
|
|
|
|
|
132
|
my $type = _get_invocant_type $subclass; |
1612
|
37
|
|
|
|
|
84
|
my @ainta = grep { !$subclass->isa($_) } @superclasses; |
|
49
|
|
|
|
|
329
|
|
1613
|
37
|
100
|
|
|
|
180
|
!@ainta || botch "your $subclass $type should be a subclass of " . commify_and(uca_sort @ainta); |
1614
|
3
|
|
|
3
|
|
796
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
78
|
|
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
sub assert_ainta($@) |
1617
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1618
|
|
|
|
|
|
|
{ |
1619
|
3
|
|
|
3
|
|
478
|
no overloading; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
453
|
|
1620
|
|
|
|
|
|
|
|
1621
|
11
|
|
|
11
|
1
|
7071
|
my($subclass, @superclasses) = @_; |
1622
|
11
|
100
|
|
|
|
48
|
@superclasses || botch "needs one or more superclasses to check against"; |
1623
|
10
|
|
|
|
|
31
|
my $type = _get_invocant_type $subclass; |
1624
|
10
|
|
|
|
|
27
|
my @isa = grep { $subclass->isa($_) } @superclasses; |
|
13
|
|
|
|
|
93
|
|
1625
|
10
|
100
|
|
|
|
63
|
!@isa || botch "your $subclass $type should not be a subclass of " . commify_or(uca_sort @isa); |
1626
|
3
|
|
|
3
|
|
22
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
sub assert_object_isa($@) |
1629
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1630
|
|
|
|
|
|
|
{ |
1631
|
14
|
|
|
14
|
1
|
11510
|
my($instance, @superclasses) = @_; |
1632
|
14
|
|
|
|
|
51
|
assert_object($instance); |
1633
|
8
|
|
|
|
|
24
|
assert_isa($instance, @superclasses); |
1634
|
3
|
|
|
3
|
|
604
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
sub assert_object_ainta($@) |
1637
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1638
|
|
|
|
|
|
|
{ |
1639
|
1
|
|
|
1
|
1
|
571
|
my($instance, @superclasses) = @_; |
1640
|
1
|
|
|
|
|
7
|
assert_object($instance); |
1641
|
1
|
|
|
|
|
9
|
assert_ainta($instance, @superclasses); |
1642
|
3
|
|
|
3
|
|
564
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
sub assert_class_isa($@) |
1645
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1646
|
|
|
|
|
|
|
{ |
1647
|
13
|
|
|
13
|
1
|
10993
|
my($class, @superclasses) = @_; |
1648
|
13
|
|
|
|
|
45
|
assert_known_package($class); |
1649
|
6
|
|
|
|
|
17
|
assert_isa($class, @superclasses); |
1650
|
3
|
|
|
3
|
|
563
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
12
|
|
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
sub assert_class_ainta($@) |
1653
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1654
|
|
|
|
|
|
|
{ |
1655
|
2
|
|
|
2
|
1
|
1698
|
my($class, @superclasses) = @_; |
1656
|
2
|
|
|
|
|
9
|
assert_known_package($class); |
1657
|
2
|
|
|
|
|
8
|
assert_ainta($class, @superclasses); |
1658
|
3
|
|
|
3
|
|
558
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
16
|
|
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
sub assert_does($@) |
1661
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1662
|
|
|
|
|
|
|
{ |
1663
|
3
|
|
|
3
|
|
443
|
no overloading; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
555
|
|
1664
|
6
|
|
|
6
|
1
|
20146
|
my($invocant, @roles) = @_; |
1665
|
6
|
100
|
|
|
|
27
|
@roles || botch "needs one or more roles to check against"; |
1666
|
5
|
|
|
|
|
63
|
my $type = _get_invocant_type $invocant; |
1667
|
5
|
|
|
|
|
12
|
my @doesnt = grep { !$invocant->DOES($_) } @roles; |
|
8
|
|
|
|
|
104
|
|
1668
|
5
|
100
|
100
|
|
|
604
|
!@doesnt || botch "your $type $invocant does not have role" |
1669
|
|
|
|
|
|
|
. (@doesnt > 1 && "s") . " " |
1670
|
|
|
|
|
|
|
. commify_or(uca_sort @doesnt); |
1671
|
3
|
|
|
3
|
|
38
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
sub assert_doesnt($@) |
1674
|
|
|
|
|
|
|
:Assert( qw[object] ) |
1675
|
|
|
|
|
|
|
{ |
1676
|
3
|
|
|
3
|
|
462
|
no overloading; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
503
|
|
1677
|
4
|
|
|
4
|
1
|
11968
|
my($invocant, @roles) = @_; |
1678
|
4
|
100
|
|
|
|
20
|
@roles || botch "needs one or more roles to check against"; |
1679
|
3
|
|
|
|
|
11
|
my $type = _get_invocant_type $invocant; |
1680
|
3
|
|
|
|
|
8
|
my @does = grep { $invocant->DOES($_) } @roles; |
|
3
|
|
|
|
|
78
|
|
1681
|
3
|
100
|
50
|
|
|
606
|
!@does || botch "your $type $invocant does not have role" |
1682
|
|
|
|
|
|
|
. (@does > 1 && "s") . " " |
1683
|
|
|
|
|
|
|
. commify_or(uca_sort @does); |
1684
|
3
|
|
|
3
|
|
25
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
sub assert_object_overloads($@) |
1687
|
|
|
|
|
|
|
:Assert( qw[object overload] ) |
1688
|
|
|
|
|
|
|
{ |
1689
|
3
|
|
|
3
|
|
476
|
no overloading; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
517
|
|
1690
|
15
|
|
|
15
|
1
|
4590
|
&assert_object; |
1691
|
14
|
|
|
|
|
49
|
my($object, @operators) = @_; |
1692
|
14
|
100
|
|
|
|
59
|
overload::Overloaded($object) || botch "your $object isn't overloaded"; |
1693
|
9
|
|
|
|
|
417
|
my @missing = grep { !overload::Method($object, $_) } @operators; |
|
18
|
|
|
|
|
420
|
|
1694
|
9
|
100
|
100
|
|
|
369
|
!@missing || botch "your $object does not overload the operator" |
1695
|
|
|
|
|
|
|
. (@missing > 1 && "s") . " " |
1696
|
|
|
|
|
|
|
. quotify_or(@missing); |
1697
|
3
|
|
|
3
|
|
26
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
15
|
|
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
sub assert_object_stringifies($) |
1700
|
|
|
|
|
|
|
:Assert( qw[object overload] ) |
1701
|
|
|
|
|
|
|
{ |
1702
|
3
|
|
|
3
|
1
|
2751
|
my($object) = @_; |
1703
|
3
|
|
|
|
|
80
|
assert_object_overloads $object, q{""}; |
1704
|
3
|
|
|
3
|
|
547
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
sub assert_object_nummifies($) |
1707
|
|
|
|
|
|
|
:Assert( qw[object overload] ) |
1708
|
|
|
|
|
|
|
{ |
1709
|
3
|
|
|
3
|
1
|
2291
|
my($object) = @_; |
1710
|
3
|
|
|
|
|
12
|
assert_object_overloads $object, q{0+}; |
1711
|
3
|
|
|
3
|
|
537
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
sub assert_object_boolifies($) |
1714
|
|
|
|
|
|
|
:Assert( qw[object overload] ) |
1715
|
|
|
|
|
|
|
{ |
1716
|
3
|
|
|
3
|
1
|
2387
|
my($object) = @_; |
1717
|
3
|
|
|
|
|
15
|
assert_object_overloads $object, q{bool}; |
1718
|
3
|
|
|
3
|
|
542
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
14
|
|
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
######################################### |
1721
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
# Some of these can trigger unwanted overloads. |
1723
|
|
|
|
|
|
|
{ |
1724
|
3
|
|
|
3
|
|
420
|
no overloading; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
182
|
|
1725
|
|
|
|
|
|
|
|
1726
|
|
|
|
|
|
|
sub assert_tied(\[$@%*]) |
1727
|
|
|
|
|
|
|
:Assert( qw[tie] ) |
1728
|
|
|
|
|
|
|
{ |
1729
|
8
|
|
|
8
|
1
|
7689
|
&assert_tied_referent; |
1730
|
3
|
|
|
3
|
|
17
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
13
|
|
1731
|
|
|
|
|
|
|
|
1732
|
|
|
|
|
|
|
sub assert_untied(\[$@%*]) |
1733
|
|
|
|
|
|
|
:Assert( qw[tie] ) |
1734
|
|
|
|
|
|
|
{ |
1735
|
8
|
|
|
8
|
1
|
6851
|
&assert_untied_referent; |
1736
|
3
|
|
|
3
|
|
502
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
1737
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
sub assert_tied_referent($) |
1739
|
|
|
|
|
|
|
:Assert( qw[tie ref] ) |
1740
|
|
|
|
|
|
|
{ |
1741
|
15
|
|
|
15
|
1
|
44060
|
&assert_anyref; |
1742
|
15
|
|
|
|
|
39
|
my($ref) = @_; |
1743
|
15
|
|
|
|
|
63
|
my $type = reftype $ref; |
1744
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
# eg: SCALAR => \&assert_tied_scalarref, |
1746
|
|
|
|
|
|
|
state $assert_by_type = { |
1747
|
|
|
|
|
|
|
map { |
1748
|
3
|
|
|
3
|
|
607
|
$_ => do { no strict "refs"; \&{ "assert_tied_" . lc . "ref" } } |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
530
|
|
|
15
|
|
|
|
|
33
|
|
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
26
|
|
1749
|
|
|
|
|
|
|
} qw(SCALAR ARRAY HASH GLOB) |
1750
|
|
|
|
|
|
|
}; |
1751
|
|
|
|
|
|
|
|
1752
|
15
|
|
|
|
|
56
|
my $assertion = $$assert_by_type{$type}; |
1753
|
15
|
100
|
66
|
|
|
96
|
$assertion && defined &$assertion |
1754
|
|
|
|
|
|
|
|| botch "invalid reftype to check for ties: '$type'"; |
1755
|
13
|
|
|
|
|
73
|
&$assertion($ref); |
1756
|
3
|
|
|
3
|
|
27
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
15
|
|
1757
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
sub assert_untied_referent($) |
1759
|
|
|
|
|
|
|
:Assert( qw[tie ref] ) |
1760
|
|
|
|
|
|
|
{ |
1761
|
17
|
|
|
17
|
1
|
7514
|
&assert_anyref; |
1762
|
17
|
|
|
|
|
35
|
my($ref) = @_; |
1763
|
17
|
|
|
|
|
60
|
my $type = reftype $ref; |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
# eg: SCALAR => \&assert_untied_scalarref, |
1766
|
|
|
|
|
|
|
state $assert_by_type = { |
1767
|
|
|
|
|
|
|
map { |
1768
|
3
|
|
|
3
|
|
572
|
$_ => do { no strict "refs"; \&{ "assert_untied_" . lc . "ref" } }, |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
435
|
|
|
17
|
|
|
|
|
37
|
|
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
22
|
|
1769
|
|
|
|
|
|
|
} qw(SCALAR ARRAY HASH GLOB), |
1770
|
|
|
|
|
|
|
}; |
1771
|
|
|
|
|
|
|
|
1772
|
17
|
|
|
|
|
32
|
my $assertion = $$assert_by_type{$type}; |
1773
|
17
|
100
|
66
|
|
|
111
|
$assertion && defined &$assertion |
1774
|
|
|
|
|
|
|
|| botch "invalid reftype to check for ties: '$type'"; |
1775
|
16
|
|
|
|
|
60
|
&$assertion($ref); |
1776
|
|
|
|
|
|
|
|
1777
|
3
|
|
|
3
|
|
32
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
14
|
|
1778
|
|
|
|
|
|
|
|
1779
|
|
|
|
|
|
|
sub assert_tied_scalar(\$) |
1780
|
|
|
|
|
|
|
:Assert( qw[tie scalar] ) |
1781
|
|
|
|
|
|
|
{ |
1782
|
2
|
|
|
2
|
1
|
1642
|
&assert_tied_scalarref; |
1783
|
3
|
|
|
3
|
|
505
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1784
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
sub assert_untied_scalar(\$) |
1786
|
|
|
|
|
|
|
:Assert( qw[tie scalar] ) |
1787
|
|
|
|
|
|
|
{ |
1788
|
2
|
|
|
2
|
1
|
1720
|
&assert_untied_scalarref; |
1789
|
3
|
|
|
3
|
|
502
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
sub assert_tied_scalarref($) |
1792
|
|
|
|
|
|
|
:Assert( qw[tie scalar ref] ) |
1793
|
|
|
|
|
|
|
{ |
1794
|
7
|
|
|
7
|
1
|
1693
|
&assert_scalarref; |
1795
|
6
|
|
|
|
|
16
|
my($scalarref) = @_; |
1796
|
6
|
100
|
|
|
|
34
|
tied($$scalarref) || botch "scalar is not tied"; |
1797
|
3
|
|
|
3
|
|
590
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
15
|
|
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
sub assert_untied_scalarref($) |
1800
|
|
|
|
|
|
|
:Assert( qw[tie scalar ref] ) |
1801
|
|
|
|
|
|
|
{ |
1802
|
8
|
|
|
8
|
1
|
1672
|
&assert_scalarref; |
1803
|
8
|
|
|
|
|
17
|
my($scalarref) = @_; |
1804
|
8
|
100
|
|
|
|
56
|
!tied($$scalarref) || botch "scalar is tied"; |
1805
|
3
|
|
|
3
|
|
578
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
sub assert_tied_array(\@) |
1808
|
|
|
|
|
|
|
:Assert( qw[tie array] ) |
1809
|
|
|
|
|
|
|
{ |
1810
|
2
|
|
|
2
|
1
|
2035
|
&assert_tied_arrayref; |
1811
|
3
|
|
|
3
|
|
498
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
sub assert_untied_array(\@) |
1814
|
|
|
|
|
|
|
:Assert( qw[tie array] ) |
1815
|
|
|
|
|
|
|
{ |
1816
|
2
|
|
|
2
|
1
|
1678
|
&assert_untied_arrayref; |
1817
|
3
|
|
|
3
|
|
511
|
} |
|
3
|
|
|
|
|
20
|
|
|
3
|
|
|
|
|
13
|
|
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
sub assert_tied_arrayref($) |
1820
|
|
|
|
|
|
|
:Assert( qw[tie array ref] ) |
1821
|
|
|
|
|
|
|
{ |
1822
|
7
|
|
|
7
|
1
|
1665
|
&assert_arrayref; |
1823
|
6
|
|
|
|
|
20
|
my($arrayref) = @_; |
1824
|
6
|
100
|
|
|
|
32
|
tied(@$arrayref) || botch "array is not tied"; |
1825
|
3
|
|
|
3
|
|
570
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
14
|
|
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
sub assert_untied_arrayref($) |
1828
|
|
|
|
|
|
|
:Assert( qw[tie array ref] ) |
1829
|
|
|
|
|
|
|
{ |
1830
|
8
|
|
|
8
|
1
|
1660
|
&assert_arrayref; |
1831
|
8
|
|
|
|
|
22
|
my($arrayref) = @_; |
1832
|
8
|
100
|
|
|
|
46
|
!tied(@$arrayref) || botch "array is tied"; |
1833
|
3
|
|
|
3
|
|
625
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
15
|
|
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
sub assert_tied_hash(\%) |
1836
|
|
|
|
|
|
|
:Assert( qw[tie hash] ) |
1837
|
|
|
|
|
|
|
{ |
1838
|
1
|
|
|
1
|
1
|
1018
|
&assert_tied_hashref; |
1839
|
3
|
|
|
3
|
|
499
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
12
|
|
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
sub assert_untied_hash(\%) |
1842
|
|
|
|
|
|
|
:Assert( qw[tie hash] ) |
1843
|
|
|
|
|
|
|
{ |
1844
|
2
|
|
|
2
|
1
|
1721
|
&assert_untied_hashref; |
1845
|
3
|
|
|
3
|
|
495
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
15
|
|
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
sub assert_tied_hashref($) |
1848
|
|
|
|
|
|
|
:Assert( qw[tie hash ref] ) |
1849
|
|
|
|
|
|
|
{ |
1850
|
7
|
|
|
7
|
1
|
2101
|
&assert_hashref; |
1851
|
6
|
|
|
|
|
16
|
my($hashref) = @_; |
1852
|
6
|
100
|
|
|
|
40
|
tied(%$hashref) || botch "hash is not tied"; |
1853
|
3
|
|
|
3
|
|
609
|
} |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
15
|
|
1854
|
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
|
sub assert_untied_hashref($) |
1856
|
|
|
|
|
|
|
:Assert( qw[tie hash ref] ) |
1857
|
|
|
|
|
|
|
{ |
1858
|
8
|
|
|
8
|
1
|
1679
|
&assert_hashref; |
1859
|
8
|
|
|
|
|
17
|
my($hashref) = @_; |
1860
|
8
|
100
|
|
|
|
37
|
!tied(%$hashref) || botch "hash is tied"; |
1861
|
3
|
|
|
3
|
|
588
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
13
|
|
1862
|
|
|
|
|
|
|
|
1863
|
|
|
|
|
|
|
sub assert_tied_glob(\*) |
1864
|
|
|
|
|
|
|
:Assert( qw[tie glob] ) |
1865
|
|
|
|
|
|
|
{ |
1866
|
2
|
|
|
2
|
1
|
1539
|
&assert_tied_globref; |
1867
|
3
|
|
|
3
|
|
545
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
sub assert_untied_glob(\*) |
1870
|
|
|
|
|
|
|
:Assert( qw[tie glob] ) |
1871
|
|
|
|
|
|
|
{ |
1872
|
2
|
|
|
2
|
1
|
1659
|
&assert_untied_globref; |
1873
|
3
|
|
|
3
|
|
523
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
13
|
|
1874
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
sub assert_tied_globref($) |
1876
|
|
|
|
|
|
|
:Assert( qw[tie glob ref] ) |
1877
|
|
|
|
|
|
|
{ |
1878
|
7
|
|
|
7
|
1
|
1681
|
&assert_globref; |
1879
|
7
|
|
|
|
|
23
|
my($globref) = @_; |
1880
|
7
|
100
|
|
|
|
38
|
tied(*$globref) || botch "glob is not tied"; |
1881
|
3
|
|
|
3
|
|
608
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
18
|
|
1882
|
|
|
|
|
|
|
|
1883
|
|
|
|
|
|
|
sub assert_untied_globref($) |
1884
|
|
|
|
|
|
|
:Assert( qw[tie glob ref] ) |
1885
|
|
|
|
|
|
|
{ |
1886
|
8
|
|
|
8
|
1
|
1654
|
&assert_globref; |
1887
|
8
|
|
|
|
|
15
|
my($globref) = @_; |
1888
|
8
|
100
|
|
|
|
51
|
!tied(*$globref) || botch "glob is tied"; |
1889
|
3
|
|
|
3
|
|
567
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
} # scope for no overloading |
1892
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
# Common subroutine for the two happy/unhappy code tests. |
1894
|
|
|
|
|
|
|
sub _run_code_test($$) { |
1895
|
4
|
|
|
4
|
|
12
|
my($code, $joy) = @_; |
1896
|
4
|
|
|
|
|
19
|
assert_coderef($code); |
1897
|
4
|
100
|
|
|
|
48
|
return if !!&$code() == !!$joy; |
1898
|
2
|
100
|
|
|
|
32
|
botch sprintf "%s assertion %s is sadly %s", |
|
|
100
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
$joy ? "happy" : "unhappy", |
1900
|
|
|
|
|
|
|
subname_or_code($code), |
1901
|
|
|
|
|
|
|
$joy ? "false" : "true"; |
1902
|
|
|
|
|
|
|
} |
1903
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
sub assert_happy_code(&) |
1905
|
|
|
|
|
|
|
:Assert( qw[boolean code] ) |
1906
|
|
|
|
|
|
|
{ |
1907
|
2
|
|
|
2
|
1
|
1815
|
my($cref) = @_; |
1908
|
2
|
|
|
|
|
11
|
_run_code_test($cref => 1); |
1909
|
3
|
|
|
3
|
|
873
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
13
|
|
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
sub assert_unhappy_code(&) |
1912
|
|
|
|
|
|
|
:Assert( qw[boolean code] ) |
1913
|
|
|
|
|
|
|
{ |
1914
|
2
|
|
|
2
|
1
|
1802
|
my($cref) = @_; |
1915
|
2
|
|
|
|
|
10
|
_run_code_test($cref => 0); |
1916
|
3
|
|
|
3
|
|
556
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
12
|
|
1917
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
sub assert_open_handle($) |
1919
|
|
|
|
|
|
|
:Assert( qw[io file] ) |
1920
|
|
|
|
|
|
|
{ |
1921
|
7
|
|
|
7
|
1
|
6054
|
my($arg) = @_; |
1922
|
7
|
|
|
|
|
30
|
assert_defined($arg); |
1923
|
6
|
100
|
|
|
|
48
|
defined(openhandle($arg)) || botch "handle $arg is not an open handle"; |
1924
|
3
|
|
|
3
|
|
619
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
14
|
|
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
sub assert_regular_file($) |
1927
|
|
|
|
|
|
|
:Assert( qw[file] ) |
1928
|
|
|
|
|
|
|
{ |
1929
|
2
|
|
|
2
|
1
|
546
|
my($arg) = @_; |
1930
|
2
|
|
|
|
|
12
|
assert_defined($arg); |
1931
|
0
|
0
|
|
|
|
0
|
-f $arg || botch "appears that $arg is not a plainfile" |
1932
|
|
|
|
|
|
|
. " nor a symlink to a plainfile"; |
1933
|
3
|
|
|
3
|
|
596
|
} |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
13
|
|
1934
|
|
|
|
|
|
|
|
1935
|
|
|
|
|
|
|
sub assert_text_file($) |
1936
|
|
|
|
|
|
|
:Assert( qw[file] ) |
1937
|
|
|
|
|
|
|
{ |
1938
|
1
|
|
|
1
|
1
|
528
|
&assert_regular_file; |
1939
|
0
|
|
|
|
|
0
|
my($arg) = @_; |
1940
|
0
|
0
|
|
|
|
0
|
-T $arg || botch "appears that $arg does not contain text"; |
1941
|
3
|
|
|
3
|
|
591
|
} |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
14
|
|
1942
|
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
|
sub assert_directory($) |
1944
|
|
|
|
|
|
|
:Assert( qw[file] ) |
1945
|
|
|
|
|
|
|
{ |
1946
|
2
|
|
|
2
|
1
|
1886
|
my($arg) = @_; |
1947
|
2
|
100
|
|
|
|
82
|
-d $arg || botch "appears that $arg is not a directory" |
1948
|
|
|
|
|
|
|
. " nor a symlink to a directory"; |
1949
|
3
|
|
|
3
|
|
585
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
13
|
|
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
sub _WIFCORED(;$) { |
1952
|
12
|
50
|
|
12
|
|
32
|
my($wstat) = @_ ? $_[0] : $?; |
1953
|
|
|
|
|
|
|
# non-standard but nearly ubiquitous; too hard to fish from real sys/wait.h |
1954
|
12
|
|
100
|
|
|
104
|
return WIFSIGNALED($wstat) && !!($wstat & 128); |
1955
|
|
|
|
|
|
|
} |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
sub _coredump_message(;$) { |
1958
|
6
|
50
|
|
6
|
|
19
|
my($wstat) = @_ ? $_[0] : $?; |
1959
|
6
|
|
100
|
|
|
12
|
return _WIFCORED($wstat) && " (core dumped)"; |
1960
|
|
|
|
|
|
|
} |
1961
|
|
|
|
|
|
|
|
1962
|
|
|
|
|
|
|
sub _signum_message($) { |
1963
|
10
|
|
|
10
|
|
21
|
my($number) = @_; |
1964
|
10
|
|
|
|
|
49
|
my $name = sig_num2longname($number); |
1965
|
10
|
|
|
|
|
38
|
return "$name(#$number)"; |
1966
|
|
|
|
|
|
|
} |
1967
|
|
|
|
|
|
|
|
1968
|
|
|
|
|
|
|
sub assert_legal_exit_status(;$) |
1969
|
|
|
|
|
|
|
:Assert( qw[process] ) |
1970
|
|
|
|
|
|
|
{ |
1971
|
35
|
100
|
|
35
|
1
|
5832
|
my($wstat) = @_ ? $_[0] : $?; |
1972
|
35
|
|
|
|
|
134
|
assert_whole_number($wstat); |
1973
|
34
|
100
|
|
|
|
91
|
$wstat < 2**16 || botch "exit value $wstat over 16 bits"; |
1974
|
3
|
|
|
3
|
|
1523
|
} |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
13
|
|
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
sub assert_signalled(;$) |
1977
|
|
|
|
|
|
|
:Assert( qw[process] ) |
1978
|
|
|
|
|
|
|
{ |
1979
|
11
|
|
|
11
|
1
|
1084
|
&assert_legal_exit_status; |
1980
|
11
|
100
|
|
|
|
45
|
my($wstat) = @_ ? $_[0] : $?; |
1981
|
11
|
100
|
|
|
|
49
|
WIFSIGNALED($wstat) || botch "exit value $wstat indicates no signal"; |
1982
|
3
|
|
|
3
|
|
648
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
13
|
|
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
sub assert_unsignalled(;$) |
1985
|
|
|
|
|
|
|
:Assert( qw[process] ) |
1986
|
|
|
|
|
|
|
{ |
1987
|
3
|
|
|
3
|
1
|
2630
|
&assert_legal_exit_status; |
1988
|
3
|
50
|
|
|
|
25
|
my($wstat) = @_ ? $_[0] : $?; |
1989
|
3
|
100
|
|
|
|
21
|
WIFEXITED($wstat) && return; |
1990
|
1
|
|
|
|
|
6
|
my $signo = WTERMSIG($wstat); |
1991
|
1
|
|
|
|
|
6
|
my $sigmsg = _signum_message($signo); |
1992
|
1
|
|
|
|
|
7
|
my $cored = _coredump_message($wstat); |
1993
|
1
|
|
|
|
|
11
|
botch "exit value $wstat indicates process died from signal $sigmsg$cored"; |
1994
|
3
|
|
|
3
|
|
779
|
} |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
130
|
|
1995
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
sub assert_dumped_core(;$) |
1997
|
|
|
|
|
|
|
:Assert( qw[process] ) |
1998
|
|
|
|
|
|
|
{ |
1999
|
4
|
|
|
4
|
1
|
3183
|
&assert_signalled; |
2000
|
3
|
100
|
|
|
|
11
|
my($wstat) = @_ ? $_[0] : $?; |
2001
|
3
|
|
|
|
|
13
|
my $signo = WTERMSIG($wstat); |
2002
|
3
|
|
|
|
|
13
|
my $sigmsg = _signum_message($signo); |
2003
|
3
|
100
|
|
|
|
12
|
_WIFCORED($wstat) || botch "exit value $wstat indicates signal $sigmsg but no core dump"; |
2004
|
3
|
|
|
3
|
|
894
|
} |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
14
|
|
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
sub assert_no_coredump(;$) |
2007
|
|
|
|
|
|
|
:Assert( qw[process] ) |
2008
|
|
|
|
|
|
|
{ |
2009
|
3
|
50
|
|
3
|
1
|
2562
|
my($wstat) = @_ ? $_[0] : $?; |
2010
|
3
|
|
|
|
|
10
|
my $cored = $wstat & 128; # not standard; too hard to fish from real sys/wait.h |
2011
|
3
|
100
|
|
|
|
9
|
return unless _WIFCORED($wstat); |
2012
|
1
|
50
|
|
|
|
7
|
return unless $cored; |
2013
|
1
|
|
|
|
|
5
|
my $signo = WTERMSIG($wstat); |
2014
|
1
|
|
|
|
|
3
|
my $sigmsg = _signum_message($signo); |
2015
|
1
|
|
|
|
|
9
|
botch "exit value $wstat shows process died of a $sigmsg and dumped core"; |
2016
|
3
|
|
|
3
|
|
820
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
16
|
|
2017
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
sub assert_exited(;$) |
2019
|
|
|
|
|
|
|
:Assert( qw[process] ) |
2020
|
|
|
|
|
|
|
{ |
2021
|
14
|
|
|
14
|
1
|
4677
|
&assert_legal_exit_status; |
2022
|
14
|
100
|
|
|
|
68
|
my($wstat) = @_ ? $_[0] : $?; |
2023
|
14
|
100
|
|
|
|
55
|
return if WIFEXITED($wstat); |
2024
|
5
|
|
|
|
|
13
|
&assert_signalled; |
2025
|
5
|
|
|
|
|
12
|
my $signo = WTERMSIG($wstat); |
2026
|
5
|
|
|
|
|
13
|
my $sigmsg = _signum_message($signo); |
2027
|
5
|
|
|
|
|
16
|
my $cored = _coredump_message($wstat); |
2028
|
5
|
|
|
|
|
24
|
botch "exit value $wstat shows process did not exit but rather died of $sigmsg$cored"; |
2029
|
3
|
|
|
3
|
|
829
|
} |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
22
|
|
2030
|
|
|
|
|
|
|
|
2031
|
|
|
|
|
|
|
sub assert_happy_exit(;$) |
2032
|
|
|
|
|
|
|
:Assert( qw[process] ) |
2033
|
|
|
|
|
|
|
{ |
2034
|
5
|
|
|
5
|
1
|
10646
|
&assert_exited; |
2035
|
3
|
100
|
|
|
|
17
|
my($wstat) = @_ ? $_[0] : $?; |
2036
|
3
|
|
|
|
|
15
|
my $exit = WEXITSTATUS($wstat); |
2037
|
3
|
100
|
|
|
|
26
|
$exit == 0 || botch "exit status $exit is not a happy exit"; |
2038
|
3
|
|
|
3
|
|
658
|
} |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
15
|
|
2039
|
|
|
|
|
|
|
|
2040
|
|
|
|
|
|
|
sub assert_sad_exit(;$) |
2041
|
|
|
|
|
|
|
:Assert( qw[process] ) |
2042
|
|
|
|
|
|
|
{ |
2043
|
3
|
|
|
3
|
1
|
9648
|
&assert_exited; |
2044
|
3
|
100
|
|
|
|
31
|
my($wstat) = @_ ? $_[0] : $?; |
2045
|
3
|
|
|
|
|
29
|
my $exit = WEXITSTATUS($wstat); |
2046
|
3
|
100
|
|
|
|
41
|
$exit != 0 || botch "exit status 0 is an unexpectedly happy exit"; |
2047
|
3
|
|
|
3
|
|
620
|
} |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
13
|
|
2048
|
|
|
|
|
|
|
|
2049
|
|
|
|
|
|
|
# If you actually *execute*(!) this module as though it were a perl |
2050
|
|
|
|
|
|
|
# script rather than merely require or compile it, it dumps out its |
2051
|
|
|
|
|
|
|
# export table like the pmexp tool from the pmtools distribution does. |
2052
|
|
|
|
|
|
|
# If moreover the ASSERT_CONDITIONAL_BUILD_POD envariable is true, then |
2053
|
|
|
|
|
|
|
# this actually generates pod you can use directly. This is used by the |
2054
|
|
|
|
|
|
|
# etc/generate-exporter-pod script from the source directory; this |
2055
|
|
|
|
|
|
|
# script is not installed, and is just a helper. |
2056
|
|
|
|
|
|
|
|
2057
|
|
|
|
|
|
|
exit !dump_exports(@ARGV) unless his_is_require(-1); |
2058
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
# This can't execute at the "normal" time or else |
2060
|
|
|
|
|
|
|
# namespace::autoclean's call Sub::Identify freaks: |
2061
|
|
|
|
|
|
|
UNITCHECK { close(DATA) if defined fileno(DATA) } |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
1; |
2064
|
|
|
|
|
|
|
|
2065
|
|
|
|
|
|
|
|
2066
|
|
|
|
|
|
|
# This has to be __DATA__ not __END__ for the self-executing |
2067
|
|
|
|
|
|
|
# trick to work right. |
2068
|
|
|
|
|
|
|
__DATA__ |
2069
|
|
|
|
|
|
|
|
2070
|
|
|
|
|
|
|
=encoding utf8 |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
=head1 NAME |
2073
|
|
|
|
|
|
|
|
2074
|
|
|
|
|
|
|
Assert::Conditional - conditionally-compiled code assertions |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
=head1 SYNOPSIS |
2077
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
# use them all unconditionally |
2079
|
|
|
|
|
|
|
use Assert::Conditional qw(:all -if 1); |
2080
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
# Use them based on some external conditional available |
2082
|
|
|
|
|
|
|
# at compile time. |
2083
|
|
|
|
|
|
|
use Assert::Conditional qw(:all) |
2084
|
|
|
|
|
|
|
=> -if => ( $ENV{DEBUG} && ! $ENV{NDEBUG} ); |
2085
|
|
|
|
|
|
|
|
2086
|
|
|
|
|
|
|
# Use them based on some external conditional available |
2087
|
|
|
|
|
|
|
# at compile time. |
2088
|
|
|
|
|
|
|
use Assert::Conditional qw(:all) |
2089
|
|
|
|
|
|
|
=> -unless => $ENV{RUNTIME} eq "production"; |
2090
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
# Method that should be called in list context with two array refs |
2092
|
|
|
|
|
|
|
# as arguments, and which should have both a "cross_product" and |
2093
|
|
|
|
|
|
|
# a "cross_tees" method available to it. |
2094
|
|
|
|
|
|
|
|
2095
|
|
|
|
|
|
|
sub some_method { |
2096
|
|
|
|
|
|
|
assert_list_context(); |
2097
|
|
|
|
|
|
|
assert_object_method(); |
2098
|
|
|
|
|
|
|
|
2099
|
|
|
|
|
|
|
assert_argc(3); |
2100
|
|
|
|
|
|
|
my($self, $left, $right) = @_; |
2101
|
|
|
|
|
|
|
|
2102
|
|
|
|
|
|
|
assert_arrayref($left); |
2103
|
|
|
|
|
|
|
assert_arrayref($right); |
2104
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
assert_can($self, "cross_product", "cross_tees"); |
2106
|
|
|
|
|
|
|
|
2107
|
|
|
|
|
|
|
... |
2108
|
|
|
|
|
|
|
|
2109
|
|
|
|
|
|
|
assert_happy_code { $i > $j }; |
2110
|
|
|
|
|
|
|
|
2111
|
|
|
|
|
|
|
... |
2112
|
|
|
|
|
|
|
} |
2113
|
|
|
|
|
|
|
|
2114
|
|
|
|
|
|
|
=head1 DESCRIPTION |
2115
|
|
|
|
|
|
|
|
2116
|
|
|
|
|
|
|
C programmers have always had F<assert.h> to conditionally compile |
2117
|
|
|
|
|
|
|
assertions into their programs, but options available for Perl programmers |
2118
|
|
|
|
|
|
|
are not so convenient. |
2119
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
Several assertion modules related to assertions exist on CPAN, but none |
2121
|
|
|
|
|
|
|
works quite like this one does, probably due to differing design goals. |
2122
|
|
|
|
|
|
|
There was nothing that allowed you to say what C programmers could say: |
2123
|
|
|
|
|
|
|
|
2124
|
|
|
|
|
|
|
assert(colors > 10) |
2125
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
And then have the "colors > 10" bit included in the failure message if it |
2127
|
|
|
|
|
|
|
didn't work, thanks to the C preprocessor. See L</assert_happy_code> |
2128
|
|
|
|
|
|
|
for a way to do that very same thing. |
2129
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
=head2 Runtime Control of Assertions |
2131
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
No matter what assertions you conditionally use, there may be times |
2133
|
|
|
|
|
|
|
when you have a running piece of software that you want to change |
2134
|
|
|
|
|
|
|
the assertion behavior of without changing the source code. |
2135
|
|
|
|
|
|
|
|
2136
|
|
|
|
|
|
|
For that, the C<ASSERT_CONDITIONAL> environment variable is used to override |
2137
|
|
|
|
|
|
|
the current defaults. |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
=over |
2140
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
=item never |
2142
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
Assertions are never imported, and even if you somehow manage to import |
2144
|
|
|
|
|
|
|
them, they will never never make a peep nor raise an exception. |
2145
|
|
|
|
|
|
|
|
2146
|
|
|
|
|
|
|
=item always |
2147
|
|
|
|
|
|
|
|
2148
|
|
|
|
|
|
|
Assertions are always imported, and even if you somehow manage to avoid importing |
2149
|
|
|
|
|
|
|
them, they will still raise an exception on error. This is the default. |
2150
|
|
|
|
|
|
|
|
2151
|
|
|
|
|
|
|
=item carp |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
Assertions are always imported but they do not raise an exception if they |
2154
|
|
|
|
|
|
|
fail; instead they all carp at you. This is true even if you somehow |
2155
|
|
|
|
|
|
|
manage to call an assertion you haven't imported. |
2156
|
|
|
|
|
|
|
|
2157
|
|
|
|
|
|
|
Note that if combined, you can get both effects: |
2158
|
|
|
|
|
|
|
|
2159
|
|
|
|
|
|
|
ASSERT_CONDITIONAL="carp,always" |
2160
|
|
|
|
|
|
|
|
2161
|
|
|
|
|
|
|
=item handlers |
2162
|
|
|
|
|
|
|
|
2163
|
|
|
|
|
|
|
Only usable in conjunction with another of the previous three, as in |
2164
|
|
|
|
|
|
|
|
2165
|
|
|
|
|
|
|
ASSERT_CONDITIONAL="always,handlers" |
2166
|
|
|
|
|
|
|
|
2167
|
|
|
|
|
|
|
Unless this option is specified, C<$SIG{__WARN__}> and C<$SIG{__DIE__}> |
2168
|
|
|
|
|
|
|
handlers will be suppressed if the assertion fails while the ensuing a |
2169
|
|
|
|
|
|
|
C<confess> or C<carp> is needed. |
2170
|
|
|
|
|
|
|
|
2171
|
|
|
|
|
|
|
=back |
2172
|
|
|
|
|
|
|
|
2173
|
|
|
|
|
|
|
These may be combined for stacked effects, but "never" cancels |
2174
|
|
|
|
|
|
|
all of them. For example: |
2175
|
|
|
|
|
|
|
|
2176
|
|
|
|
|
|
|
ASSERT_CONDITIONAL="carp,always" |
2177
|
|
|
|
|
|
|
ASSERT_CONDITIONAL="carp,handlers" |
2178
|
|
|
|
|
|
|
ASSERT_CONDITIONAL="carp,always,handlers" |
2179
|
|
|
|
|
|
|
|
2180
|
|
|
|
|
|
|
=head2 Inventory of Assertions |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
Here in alphabetical order is the list of all assertions with their prototypes. |
2183
|
|
|
|
|
|
|
Following this is a list of assertions grouped by category, and finally |
2184
|
|
|
|
|
|
|
a description of what each one does. |
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
assert_ainta ( $@ ) ; |
2187
|
|
|
|
|
|
|
assert_alnum ( $ ) ; |
2188
|
|
|
|
|
|
|
assert_alphabetic ( $ ) ; |
2189
|
|
|
|
|
|
|
assert_anyref ( $ ) ; |
2190
|
|
|
|
|
|
|
assert_argc ( ;$ ) ; |
2191
|
|
|
|
|
|
|
assert_argc_max ( $ ) ; |
2192
|
|
|
|
|
|
|
assert_argc_min ( $ ) ; |
2193
|
|
|
|
|
|
|
assert_argc_minmax ( $$ ) ; |
2194
|
|
|
|
|
|
|
assert_array_length ( \@ ;$) ; |
2195
|
|
|
|
|
|
|
assert_array_length_max ( \@ $ ) ; |
2196
|
|
|
|
|
|
|
assert_array_length_min ( \@ $ ) ; |
2197
|
|
|
|
|
|
|
assert_array_length_minmax ( \@ $$) ; |
2198
|
|
|
|
|
|
|
assert_array_nonempty ( \@ ) ; |
2199
|
|
|
|
|
|
|
assert_arrayref ( $ ) ; |
2200
|
|
|
|
|
|
|
assert_arrayref_nonempty ( $ ) ; |
2201
|
|
|
|
|
|
|
assert_ascii ( $ ) ; |
2202
|
|
|
|
|
|
|
assert_ascii_ident ( $ ) ; |
2203
|
|
|
|
|
|
|
assert_astral ( $ ) ; |
2204
|
|
|
|
|
|
|
assert_blank ( $ ) ; |
2205
|
|
|
|
|
|
|
assert_bmp ( $ ) ; |
2206
|
|
|
|
|
|
|
assert_box_number ( $ ) ; |
2207
|
|
|
|
|
|
|
assert_bytes ( $ ) ; |
2208
|
|
|
|
|
|
|
assert_can ( $@ ) ; |
2209
|
|
|
|
|
|
|
assert_cant ( $@ ) ; |
2210
|
|
|
|
|
|
|
assert_class_ainta ( $@ ) ; |
2211
|
|
|
|
|
|
|
assert_class_can ( $@ ) ; |
2212
|
|
|
|
|
|
|
assert_class_cant ( $@ ) ; |
2213
|
|
|
|
|
|
|
assert_class_isa ( $@ ) ; |
2214
|
|
|
|
|
|
|
assert_class_method ( ) ; |
2215
|
|
|
|
|
|
|
assert_coderef ( $ ) ; |
2216
|
|
|
|
|
|
|
assert_defined ( $ ) ; |
2217
|
|
|
|
|
|
|
assert_defined_value ( $ ) ; |
2218
|
|
|
|
|
|
|
assert_defined_variable ( \$ ) ; |
2219
|
|
|
|
|
|
|
assert_digits ( $ ) ; |
2220
|
|
|
|
|
|
|
assert_directory ( $ ) ; |
2221
|
|
|
|
|
|
|
assert_does ( $@ ) ; |
2222
|
|
|
|
|
|
|
assert_doesnt ( $@ ) ; |
2223
|
|
|
|
|
|
|
assert_dumped_core ( ;$ ) ; |
2224
|
|
|
|
|
|
|
assert_empty ( $ ) ; |
2225
|
|
|
|
|
|
|
assert_eq ( $$ ) ; |
2226
|
|
|
|
|
|
|
assert_eq_letters ( $$ ) ; |
2227
|
|
|
|
|
|
|
assert_even_number ( $ ) ; |
2228
|
|
|
|
|
|
|
assert_exited ( ;$ ) ; |
2229
|
|
|
|
|
|
|
assert_false ( $ ) ; |
2230
|
|
|
|
|
|
|
assert_fractional ( $ ) ; |
2231
|
|
|
|
|
|
|
assert_full_perl_ident ( $ ) ; |
2232
|
|
|
|
|
|
|
assert_globref ( $ ) ; |
2233
|
|
|
|
|
|
|
assert_happy_code ( & ) ; |
2234
|
|
|
|
|
|
|
assert_happy_exit ( ;$ ) ; |
2235
|
|
|
|
|
|
|
assert_hash_keys ( \% @ ) ; |
2236
|
|
|
|
|
|
|
assert_hash_keys_allowed ( \% @ ) ; |
2237
|
|
|
|
|
|
|
assert_hash_keys_allowed_and_required ( \% $ $ ) ; |
2238
|
|
|
|
|
|
|
assert_hash_keys_required ( \% @ ) ; |
2239
|
|
|
|
|
|
|
assert_hash_keys_required_and_allowed ( \% $ $ ) ; |
2240
|
|
|
|
|
|
|
assert_hash_nonempty ( \% ) ; |
2241
|
|
|
|
|
|
|
assert_hashref ( $ ) ; |
2242
|
|
|
|
|
|
|
assert_hashref_keys ( $@ ) ; |
2243
|
|
|
|
|
|
|
assert_hashref_keys_allowed ( $@ ) ; |
2244
|
|
|
|
|
|
|
assert_hashref_keys_allowed_and_required ( $$$ ) ; |
2245
|
|
|
|
|
|
|
assert_hashref_keys_required ( $@ ) ; |
2246
|
|
|
|
|
|
|
assert_hashref_keys_required_and_allowed ( $$$ ) ; |
2247
|
|
|
|
|
|
|
assert_hashref_nonempty ( $ ) ; |
2248
|
|
|
|
|
|
|
assert_hex_number ( $ ) ; |
2249
|
|
|
|
|
|
|
assert_in_list ( $@ ) ; |
2250
|
|
|
|
|
|
|
assert_in_numeric_range ( $$$ ) ; |
2251
|
|
|
|
|
|
|
assert_integer ( $ ) ; |
2252
|
|
|
|
|
|
|
assert_ioref ( $ ) ; |
2253
|
|
|
|
|
|
|
assert_is ( $$ ) ; |
2254
|
|
|
|
|
|
|
assert_isa ( $@ ) ; |
2255
|
|
|
|
|
|
|
assert_isnt ( $$ ) ; |
2256
|
|
|
|
|
|
|
assert_keys ( \[%$] @ ) ; |
2257
|
|
|
|
|
|
|
assert_known_package ( $ ) ; |
2258
|
|
|
|
|
|
|
assert_latin1 ( $ ) ; |
2259
|
|
|
|
|
|
|
assert_latinish ( $ ) ; |
2260
|
|
|
|
|
|
|
assert_legal_exit_status ( ;$ ) ; |
2261
|
|
|
|
|
|
|
assert_like ( $$ ) ; |
2262
|
|
|
|
|
|
|
assert_list_context ( ) ; |
2263
|
|
|
|
|
|
|
assert_list_nonempty ( @ ) ; |
2264
|
|
|
|
|
|
|
assert_locked ( \[%$] @ ) ; |
2265
|
|
|
|
|
|
|
assert_lowercased ( $ ) ; |
2266
|
|
|
|
|
|
|
assert_max_keys ( \[%$] @ ) ; |
2267
|
|
|
|
|
|
|
assert_method ( ) ; |
2268
|
|
|
|
|
|
|
assert_min_keys ( \[%$] @ ) ; |
2269
|
|
|
|
|
|
|
assert_minmax_keys ( \[%$] \[@$] \[@$] ) ; |
2270
|
|
|
|
|
|
|
assert_multi_line ( $ ) ; |
2271
|
|
|
|
|
|
|
assert_natural_number ( $ ) ; |
2272
|
|
|
|
|
|
|
assert_negative ( $ ) ; |
2273
|
|
|
|
|
|
|
assert_negative_integer ( $ ) ; |
2274
|
|
|
|
|
|
|
assert_nfc ( $ ) ; |
2275
|
|
|
|
|
|
|
assert_nfd ( $ ) ; |
2276
|
|
|
|
|
|
|
assert_nfkc ( $ ) ; |
2277
|
|
|
|
|
|
|
assert_nfkd ( $ ) ; |
2278
|
|
|
|
|
|
|
assert_no_coredump ( ;$ ) ; |
2279
|
|
|
|
|
|
|
assert_nonalphabetic ( $ ) ; |
2280
|
|
|
|
|
|
|
assert_nonascii ( $ ) ; |
2281
|
|
|
|
|
|
|
assert_nonastral ( $ ) ; |
2282
|
|
|
|
|
|
|
assert_nonblank ( $ ) ; |
2283
|
|
|
|
|
|
|
assert_nonbytes ( $ ) ; |
2284
|
|
|
|
|
|
|
assert_nonempty ( $ ) ; |
2285
|
|
|
|
|
|
|
assert_nonlist_context ( ) ; |
2286
|
|
|
|
|
|
|
assert_nonnegative ( $ ) ; |
2287
|
|
|
|
|
|
|
assert_nonnegative_integer ( $ ) ; |
2288
|
|
|
|
|
|
|
assert_nonnumeric ( $ ) ; |
2289
|
|
|
|
|
|
|
assert_nonobject ( $ ) ; |
2290
|
|
|
|
|
|
|
assert_nonpositive ( $ ) ; |
2291
|
|
|
|
|
|
|
assert_nonpositive_integer ( $ ) ; |
2292
|
|
|
|
|
|
|
assert_nonref ( $ ) ; |
2293
|
|
|
|
|
|
|
assert_nonvoid_context ( ) ; |
2294
|
|
|
|
|
|
|
assert_nonzero ( $ ) ; |
2295
|
|
|
|
|
|
|
assert_not_in_list ( $@ ) ; |
2296
|
|
|
|
|
|
|
assert_numeric ( $ ) ; |
2297
|
|
|
|
|
|
|
assert_object ( $ ) ; |
2298
|
|
|
|
|
|
|
assert_object_ainta ( $@ ) ; |
2299
|
|
|
|
|
|
|
assert_object_boolifies ( $ ) ; |
2300
|
|
|
|
|
|
|
assert_object_can ( $@ ) ; |
2301
|
|
|
|
|
|
|
assert_object_cant ( $@ ) ; |
2302
|
|
|
|
|
|
|
assert_object_isa ( $@ ) ; |
2303
|
|
|
|
|
|
|
assert_object_method ( ) ; |
2304
|
|
|
|
|
|
|
assert_object_nummifies ( $ ) ; |
2305
|
|
|
|
|
|
|
assert_object_overloads ( $@ ) ; |
2306
|
|
|
|
|
|
|
assert_object_stringifies ( $ ) ; |
2307
|
|
|
|
|
|
|
assert_odd_number ( $ ) ; |
2308
|
|
|
|
|
|
|
assert_open_handle ( $ ) ; |
2309
|
|
|
|
|
|
|
assert_positive ( $ ) ; |
2310
|
|
|
|
|
|
|
assert_positive_integer ( $ ) ; |
2311
|
|
|
|
|
|
|
assert_private_method ( ) ; |
2312
|
|
|
|
|
|
|
assert_protected_method ( ) ; |
2313
|
|
|
|
|
|
|
assert_public_method ( ) ; |
2314
|
|
|
|
|
|
|
assert_qualified_ident ( $ ) ; |
2315
|
|
|
|
|
|
|
assert_refref ( $ ) ; |
2316
|
|
|
|
|
|
|
assert_reftype ( $$ ) ; |
2317
|
|
|
|
|
|
|
assert_regex ( $ ) ; |
2318
|
|
|
|
|
|
|
assert_regular_file ( $ ) ; |
2319
|
|
|
|
|
|
|
assert_sad_exit ( ;$ ) ; |
2320
|
|
|
|
|
|
|
assert_scalar_context ( ) ; |
2321
|
|
|
|
|
|
|
assert_scalarref ( $ ) ; |
2322
|
|
|
|
|
|
|
assert_signalled ( ;$ ) ; |
2323
|
|
|
|
|
|
|
assert_signed_number ( $ ) ; |
2324
|
|
|
|
|
|
|
assert_simple_perl_ident ( $ ) ; |
2325
|
|
|
|
|
|
|
assert_single_line ( $ ) ; |
2326
|
|
|
|
|
|
|
assert_single_paragraph ( $ ) ; |
2327
|
|
|
|
|
|
|
assert_text_file ( $ ) ; |
2328
|
|
|
|
|
|
|
assert_tied ( \[$@*] ) ; |
2329
|
|
|
|
|
|
|
assert_tied_array ( \@ ) ; |
2330
|
|
|
|
|
|
|
assert_tied_arrayref ( $ ) ; |
2331
|
|
|
|
|
|
|
assert_tied_glob ( \* ) ; |
2332
|
|
|
|
|
|
|
assert_tied_globref ( $ ) ; |
2333
|
|
|
|
|
|
|
assert_tied_hash ( \% ) ; |
2334
|
|
|
|
|
|
|
assert_tied_hashref ( $ ) ; |
2335
|
|
|
|
|
|
|
assert_tied_referent ( $ ) ; |
2336
|
|
|
|
|
|
|
assert_tied_scalar ( \$ ) ; |
2337
|
|
|
|
|
|
|
assert_tied_scalarref ( $ ) ; |
2338
|
|
|
|
|
|
|
assert_true ( $ ) ; |
2339
|
|
|
|
|
|
|
assert_unblessed_ref ( $ ) ; |
2340
|
|
|
|
|
|
|
assert_undefined ( $ ) ; |
2341
|
|
|
|
|
|
|
assert_unhappy_code ( & ) ; |
2342
|
|
|
|
|
|
|
assert_unicode_ident ( $ ) ; |
2343
|
|
|
|
|
|
|
assert_unlike ( $$ ) ; |
2344
|
|
|
|
|
|
|
assert_unlocked ( \[%$] @ ) ; |
2345
|
|
|
|
|
|
|
assert_unsignalled ( ;$ ) ; |
2346
|
|
|
|
|
|
|
assert_untied ( \[$@%*] ) ; |
2347
|
|
|
|
|
|
|
assert_untied_array ( \@ ) ; |
2348
|
|
|
|
|
|
|
assert_untied_arrayref ( $ ) ; |
2349
|
|
|
|
|
|
|
assert_untied_glob ( \* ) ; |
2350
|
|
|
|
|
|
|
assert_untied_globref ( $ ) ; |
2351
|
|
|
|
|
|
|
assert_untied_hash ( \% ) ; |
2352
|
|
|
|
|
|
|
assert_untied_hashref ( $ ) ; |
2353
|
|
|
|
|
|
|
assert_untied_referent ( $ ) ; |
2354
|
|
|
|
|
|
|
assert_untied_scalar ( \$ ) ; |
2355
|
|
|
|
|
|
|
assert_untied_scalarref ( $ ) ; |
2356
|
|
|
|
|
|
|
assert_uppercased ( $ ) ; |
2357
|
|
|
|
|
|
|
assert_void_context ( ) ; |
2358
|
|
|
|
|
|
|
assert_whole_number ( $ ) ; |
2359
|
|
|
|
|
|
|
assert_wide_characters ( $ ) ; |
2360
|
|
|
|
|
|
|
assert_zero ( $ ) ; |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
All assertions have function prototypes; this helps you use them correctly, |
2363
|
|
|
|
|
|
|
and in some cases casts the argument into scalar context, adds backslashes |
2364
|
|
|
|
|
|
|
to pass things by reference, so you don't have to. |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
=head2 Export Tags |
2367
|
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
|
You may import all assertions or just some of them. When importing only |
2369
|
|
|
|
|
|
|
some of them, you may wish to use an export tag to import a set of related |
2370
|
|
|
|
|
|
|
assertions. Here is what each tag imports: |
2371
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
=over |
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
=item C<:all> |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
L</assert_ainta>, L</assert_alnum>, L</assert_alphabetic>, |
2377
|
|
|
|
|
|
|
L</assert_anyref>, L</assert_argc>, L</assert_argc_max>, |
2378
|
|
|
|
|
|
|
L</assert_argc_min>, L</assert_argc_minmax>, L</assert_array_length>, |
2379
|
|
|
|
|
|
|
L</assert_array_length_max>, L</assert_array_length_min>, |
2380
|
|
|
|
|
|
|
L</assert_array_length_minmax>, L</assert_array_nonempty>, |
2381
|
|
|
|
|
|
|
L</assert_arrayref>, L</assert_arrayref_nonempty>, L</assert_ascii>, |
2382
|
|
|
|
|
|
|
L</assert_ascii_ident>, L</assert_astral>, L</assert_blank>, |
2383
|
|
|
|
|
|
|
L</assert_bmp>, L</assert_box_number>, L</assert_bytes>, L</assert_can>, |
2384
|
|
|
|
|
|
|
L</assert_cant>, L</assert_class_ainta>, L</assert_class_can>, |
2385
|
|
|
|
|
|
|
L</assert_class_cant>, L</assert_class_isa>, L</assert_class_method>, |
2386
|
|
|
|
|
|
|
L</assert_coderef>, L</assert_defined>, L</assert_defined_value>, |
2387
|
|
|
|
|
|
|
L</assert_defined_variable>, L</assert_digits>, L</assert_directory>, |
2388
|
|
|
|
|
|
|
L</assert_does>, L</assert_doesnt>, L</assert_dumped_core>, |
2389
|
|
|
|
|
|
|
L</assert_empty>, L</assert_eq>, L</assert_eq_letters>, |
2390
|
|
|
|
|
|
|
L</assert_even_number>, L</assert_exited>, L</assert_false>, |
2391
|
|
|
|
|
|
|
L</assert_fractional>, L</assert_full_perl_ident>, L</assert_globref>, |
2392
|
|
|
|
|
|
|
L</assert_happy_code>, L</assert_happy_exit>, L</assert_hash_keys>, |
2393
|
|
|
|
|
|
|
L</assert_hash_keys_allowed>, L</assert_hash_keys_allowed_and_required>, |
2394
|
|
|
|
|
|
|
L</assert_hash_keys_required>, L</assert_hash_keys_required_and_allowed>, |
2395
|
|
|
|
|
|
|
L</assert_hash_nonempty>, L</assert_hashref>, L</assert_hashref_keys>, |
2396
|
|
|
|
|
|
|
L</assert_hashref_keys_allowed>, |
2397
|
|
|
|
|
|
|
L</assert_hashref_keys_allowed_and_required>, |
2398
|
|
|
|
|
|
|
L</assert_hashref_keys_required>, |
2399
|
|
|
|
|
|
|
L</assert_hashref_keys_required_and_allowed>, L</assert_hashref_nonempty>, |
2400
|
|
|
|
|
|
|
L</assert_hex_number>, L</assert_in_list>, L</assert_in_numeric_range>, |
2401
|
|
|
|
|
|
|
L</assert_integer>, L</assert_ioref>, L</assert_is>, L</assert_isa>, |
2402
|
|
|
|
|
|
|
L</assert_isnt>, L</assert_keys>, L</assert_known_package>, |
2403
|
|
|
|
|
|
|
L</assert_latin1>, L</assert_latinish>, L</assert_legal_exit_status>, |
2404
|
|
|
|
|
|
|
L</assert_like>, L</assert_list_context>, L</assert_list_nonempty>, |
2405
|
|
|
|
|
|
|
L</assert_locked>, L</assert_lowercased>, L</assert_max_keys>, |
2406
|
|
|
|
|
|
|
L</assert_method>, L</assert_min_keys>, L</assert_minmax_keys>, |
2407
|
|
|
|
|
|
|
L</assert_multi_line>, L</assert_natural_number>, L</assert_negative>, |
2408
|
|
|
|
|
|
|
L</assert_negative_integer>, L</assert_nfc>, L</assert_nfd>, |
2409
|
|
|
|
|
|
|
L</assert_nfkc>, L</assert_nfkd>, L</assert_no_coredump>, |
2410
|
|
|
|
|
|
|
L</assert_nonalphabetic>, L</assert_nonascii>, L</assert_nonastral>, |
2411
|
|
|
|
|
|
|
L</assert_nonblank>, L</assert_nonbytes>, L</assert_nonempty>, |
2412
|
|
|
|
|
|
|
L</assert_nonlist_context>, L</assert_nonnegative>, |
2413
|
|
|
|
|
|
|
L</assert_nonnegative_integer>, L</assert_nonnumeric>, |
2414
|
|
|
|
|
|
|
L</assert_nonobject>, L</assert_nonpositive>, |
2415
|
|
|
|
|
|
|
L</assert_nonpositive_integer>, L</assert_nonref>, |
2416
|
|
|
|
|
|
|
L</assert_nonvoid_context>, L</assert_nonzero>, L</assert_not_in_list>, |
2417
|
|
|
|
|
|
|
L</assert_numeric>, L</assert_object>, L</assert_object_ainta>, |
2418
|
|
|
|
|
|
|
L</assert_object_boolifies>, L</assert_object_can>, L</assert_object_cant>, |
2419
|
|
|
|
|
|
|
L</assert_object_isa>, L</assert_object_method>, |
2420
|
|
|
|
|
|
|
L</assert_object_nummifies>, L</assert_object_overloads>, |
2421
|
|
|
|
|
|
|
L</assert_object_stringifies>, L</assert_odd_number>, |
2422
|
|
|
|
|
|
|
L</assert_open_handle>, L</assert_positive>, L</assert_positive_integer>, |
2423
|
|
|
|
|
|
|
L</assert_private_method>, L</assert_protected_method>, |
2424
|
|
|
|
|
|
|
L</assert_public_method>, L</assert_qualified_ident>, L</assert_refref>, |
2425
|
|
|
|
|
|
|
L</assert_reftype>, L</assert_regex>, L</assert_regular_file>, |
2426
|
|
|
|
|
|
|
L</assert_sad_exit>, L</assert_scalar_context>, L</assert_scalarref>, |
2427
|
|
|
|
|
|
|
L</assert_signalled>, L</assert_signed_number>, |
2428
|
|
|
|
|
|
|
L</assert_simple_perl_ident>, L</assert_single_line>, |
2429
|
|
|
|
|
|
|
L</assert_single_paragraph>, L</assert_text_file>, L</assert_tied>, |
2430
|
|
|
|
|
|
|
L</assert_tied_array>, L</assert_tied_arrayref>, L</assert_tied_glob>, |
2431
|
|
|
|
|
|
|
L</assert_tied_globref>, L</assert_tied_hash>, L</assert_tied_hashref>, |
2432
|
|
|
|
|
|
|
L</assert_tied_referent>, L</assert_tied_scalar>, |
2433
|
|
|
|
|
|
|
L</assert_tied_scalarref>, L</assert_true>, L</assert_unblessed_ref>, |
2434
|
|
|
|
|
|
|
L</assert_undefined>, L</assert_unhappy_code>, L</assert_unicode_ident>, |
2435
|
|
|
|
|
|
|
L</assert_unlike>, L</assert_unlocked>, L</assert_unsignalled>, |
2436
|
|
|
|
|
|
|
L</assert_untied>, L</assert_untied_array>, L</assert_untied_arrayref>, |
2437
|
|
|
|
|
|
|
L</assert_untied_glob>, L</assert_untied_globref>, L</assert_untied_hash>, |
2438
|
|
|
|
|
|
|
L</assert_untied_hashref>, L</assert_untied_referent>, |
2439
|
|
|
|
|
|
|
L</assert_untied_scalar>, L</assert_untied_scalarref>, |
2440
|
|
|
|
|
|
|
L</assert_uppercased>, L</assert_void_context>, L</assert_whole_number>, |
2441
|
|
|
|
|
|
|
L</assert_wide_characters>, and L</assert_zero>. |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
=item C<:argc> |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
L</assert_argc>, L</assert_argc_max>, L</assert_argc_min>, and |
2446
|
|
|
|
|
|
|
L</assert_argc_minmax>. |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
=item C<:array> |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
L</assert_array_length>, L</assert_array_length_max>, |
2451
|
|
|
|
|
|
|
L</assert_array_length_min>, L</assert_array_length_minmax>, |
2452
|
|
|
|
|
|
|
L</assert_array_nonempty>, L</assert_arrayref>, |
2453
|
|
|
|
|
|
|
L</assert_arrayref_nonempty>, L</assert_list_nonempty>, |
2454
|
|
|
|
|
|
|
L</assert_tied_array>, L</assert_tied_arrayref>, L</assert_untied_array>, |
2455
|
|
|
|
|
|
|
and L</assert_untied_arrayref>. |
2456
|
|
|
|
|
|
|
|
2457
|
|
|
|
|
|
|
=item C<:boolean> |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
L</assert_false>, L</assert_happy_code>, L</assert_true>, and |
2460
|
|
|
|
|
|
|
L</assert_unhappy_code>. |
2461
|
|
|
|
|
|
|
|
2462
|
|
|
|
|
|
|
=item C<:case> |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
L</assert_lowercased> and L</assert_uppercased>. |
2465
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
=item C<:code> |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
L</assert_coderef>, L</assert_happy_code>, and L</assert_unhappy_code>. |
2469
|
|
|
|
|
|
|
|
2470
|
|
|
|
|
|
|
=item C<:context> |
2471
|
|
|
|
|
|
|
|
2472
|
|
|
|
|
|
|
L</assert_list_context>, L</assert_nonlist_context>, |
2473
|
|
|
|
|
|
|
L</assert_nonvoid_context>, L</assert_scalar_context>, and |
2474
|
|
|
|
|
|
|
L</assert_void_context>. |
2475
|
|
|
|
|
|
|
|
2476
|
|
|
|
|
|
|
=item C<:file> |
2477
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
L</assert_directory>, L</assert_open_handle>, L</assert_regular_file>, |
2479
|
|
|
|
|
|
|
and L</assert_text_file>. |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
=item C<:glob> |
2482
|
|
|
|
|
|
|
|
2483
|
|
|
|
|
|
|
L</assert_globref>, L</assert_tied_glob>, L</assert_tied_globref>, |
2484
|
|
|
|
|
|
|
L</assert_untied_glob>, and L</assert_untied_globref>. |
2485
|
|
|
|
|
|
|
|
2486
|
|
|
|
|
|
|
=item C<:hash> |
2487
|
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
|
L</assert_hash_keys>, L</assert_hash_keys_allowed>, |
2489
|
|
|
|
|
|
|
L</assert_hash_keys_allowed_and_required>, L</assert_hash_keys_required>, |
2490
|
|
|
|
|
|
|
L</assert_hash_keys_required_and_allowed>, L</assert_hash_nonempty>, |
2491
|
|
|
|
|
|
|
L</assert_hashref>, L</assert_hashref_keys>, |
2492
|
|
|
|
|
|
|
L</assert_hashref_keys_allowed>, |
2493
|
|
|
|
|
|
|
L</assert_hashref_keys_allowed_and_required>, |
2494
|
|
|
|
|
|
|
L</assert_hashref_keys_required>, |
2495
|
|
|
|
|
|
|
L</assert_hashref_keys_required_and_allowed>, L</assert_hashref_nonempty>, |
2496
|
|
|
|
|
|
|
L</assert_keys>, L</assert_locked>, L</assert_max_keys>, |
2497
|
|
|
|
|
|
|
L</assert_min_keys>, L</assert_minmax_keys>, L</assert_tied_hash>, |
2498
|
|
|
|
|
|
|
L</assert_tied_hashref>, L</assert_unlocked>, L</assert_untied_hash>, |
2499
|
|
|
|
|
|
|
and L</assert_untied_hashref>. |
2500
|
|
|
|
|
|
|
|
2501
|
|
|
|
|
|
|
=item C<:ident> |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
L</assert_ascii_ident>, L</assert_full_perl_ident>, |
2504
|
|
|
|
|
|
|
L</assert_known_package>, L</assert_qualified_ident>, and |
2505
|
|
|
|
|
|
|
L</assert_simple_perl_ident>. |
2506
|
|
|
|
|
|
|
|
2507
|
|
|
|
|
|
|
=item C<:io> |
2508
|
|
|
|
|
|
|
|
2509
|
|
|
|
|
|
|
L</assert_ioref> and L</assert_open_handle>. |
2510
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
=item C<:list> |
2512
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
L</assert_in_list>, L</assert_list_nonempty>, and L</assert_not_in_list>. |
2514
|
|
|
|
|
|
|
|
2515
|
|
|
|
|
|
|
=item C<:number> |
2516
|
|
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
L</assert_box_number>, L</assert_digits>, L</assert_even_number>, |
2518
|
|
|
|
|
|
|
L</assert_fractional>, L</assert_hex_number>, L</assert_in_numeric_range>, |
2519
|
|
|
|
|
|
|
L</assert_integer>, L</assert_natural_number>, L</assert_negative>, |
2520
|
|
|
|
|
|
|
L</assert_negative_integer>, L</assert_nonnegative>, |
2521
|
|
|
|
|
|
|
L</assert_nonnegative_integer>, L</assert_nonnumeric>, |
2522
|
|
|
|
|
|
|
L</assert_nonpositive>, L</assert_nonpositive_integer>, L</assert_nonzero>, |
2523
|
|
|
|
|
|
|
L</assert_numeric>, L</assert_odd_number>, L</assert_positive>, |
2524
|
|
|
|
|
|
|
L</assert_positive_integer>, L</assert_signed_number>, |
2525
|
|
|
|
|
|
|
L</assert_whole_number>, and L</assert_zero>. |
2526
|
|
|
|
|
|
|
|
2527
|
|
|
|
|
|
|
=item C<:object> |
2528
|
|
|
|
|
|
|
|
2529
|
|
|
|
|
|
|
L</assert_ainta>, L</assert_can>, L</assert_cant>, L</assert_class_ainta>, |
2530
|
|
|
|
|
|
|
L</assert_class_can>, L</assert_class_cant>, L</assert_class_isa>, |
2531
|
|
|
|
|
|
|
L</assert_class_method>, L</assert_does>, L</assert_doesnt>, |
2532
|
|
|
|
|
|
|
L</assert_isa>, L</assert_known_package>, L</assert_method>, |
2533
|
|
|
|
|
|
|
L</assert_nonobject>, L</assert_object>, L</assert_object_ainta>, |
2534
|
|
|
|
|
|
|
L</assert_object_boolifies>, L</assert_object_can>, L</assert_object_cant>, |
2535
|
|
|
|
|
|
|
L</assert_object_isa>, L</assert_object_method>, |
2536
|
|
|
|
|
|
|
L</assert_object_nummifies>, L</assert_object_overloads>, |
2537
|
|
|
|
|
|
|
L</assert_object_stringifies>, L</assert_private_method>, |
2538
|
|
|
|
|
|
|
L</assert_protected_method>, L</assert_public_method>, L</assert_reftype>, |
2539
|
|
|
|
|
|
|
and L</assert_unblessed_ref>. |
2540
|
|
|
|
|
|
|
|
2541
|
|
|
|
|
|
|
=item C<:overload> |
2542
|
|
|
|
|
|
|
|
2543
|
|
|
|
|
|
|
L</assert_object_boolifies>, L</assert_object_nummifies>, |
2544
|
|
|
|
|
|
|
L</assert_object_overloads>, and L</assert_object_stringifies>. |
2545
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
=item C<:process> |
2547
|
|
|
|
|
|
|
|
2548
|
|
|
|
|
|
|
L</assert_dumped_core>, L</assert_exited>, L</assert_happy_exit>, |
2549
|
|
|
|
|
|
|
L</assert_legal_exit_status>, L</assert_no_coredump>, L</assert_sad_exit>, |
2550
|
|
|
|
|
|
|
L</assert_signalled>, and L</assert_unsignalled>. |
2551
|
|
|
|
|
|
|
|
2552
|
|
|
|
|
|
|
=item C<:ref> |
2553
|
|
|
|
|
|
|
|
2554
|
|
|
|
|
|
|
L</assert_anyref>, L</assert_arrayref>, L</assert_coderef>, |
2555
|
|
|
|
|
|
|
L</assert_globref>, L</assert_hashref>, L</assert_ioref>, |
2556
|
|
|
|
|
|
|
L</assert_nonref>, L</assert_refref>, L</assert_reftype>, |
2557
|
|
|
|
|
|
|
L</assert_scalarref>, L</assert_tied_arrayref>, L</assert_tied_globref>, |
2558
|
|
|
|
|
|
|
L</assert_tied_hashref>, L</assert_tied_referent>, |
2559
|
|
|
|
|
|
|
L</assert_tied_scalarref>, L</assert_unblessed_ref>, |
2560
|
|
|
|
|
|
|
L</assert_untied_arrayref>, L</assert_untied_globref>, |
2561
|
|
|
|
|
|
|
L</assert_untied_hashref>, L</assert_untied_referent>, and |
2562
|
|
|
|
|
|
|
L</assert_untied_scalarref>. |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
=item C<:regex> |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
L</assert_alnum>, L</assert_alphabetic>, L</assert_ascii>, |
2567
|
|
|
|
|
|
|
L</assert_ascii_ident>, L</assert_blank>, L</assert_digits>, |
2568
|
|
|
|
|
|
|
L</assert_full_perl_ident>, L</assert_hex_number>, L</assert_like>, |
2569
|
|
|
|
|
|
|
L</assert_lowercased>, L</assert_multi_line>, L</assert_nonalphabetic>, |
2570
|
|
|
|
|
|
|
L</assert_nonascii>, L</assert_nonblank>, L</assert_qualified_ident>, |
2571
|
|
|
|
|
|
|
L</assert_regex>, L</assert_simple_perl_ident>, L</assert_single_line>, |
2572
|
|
|
|
|
|
|
L</assert_single_paragraph>, L</assert_unicode_ident>, L</assert_unlike>, |
2573
|
|
|
|
|
|
|
and L</assert_uppercased>. |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
=item C<:scalar> |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
L</assert_defined>, L</assert_defined_value>, L</assert_defined_variable>, |
2578
|
|
|
|
|
|
|
L</assert_false>, L</assert_scalarref>, L</assert_tied_scalar>, |
2579
|
|
|
|
|
|
|
L</assert_tied_scalarref>, L</assert_true>, L</assert_undefined>, |
2580
|
|
|
|
|
|
|
L</assert_untied_scalar>, and L</assert_untied_scalarref>. |
2581
|
|
|
|
|
|
|
|
2582
|
|
|
|
|
|
|
=item C<:string> |
2583
|
|
|
|
|
|
|
|
2584
|
|
|
|
|
|
|
L</assert_alphabetic>, L</assert_ascii>, L</assert_blank>, |
2585
|
|
|
|
|
|
|
L</assert_bytes>, L</assert_empty>, L</assert_eq>, L</assert_eq_letters>, |
2586
|
|
|
|
|
|
|
L</assert_is>, L</assert_isnt>, L</assert_latin1>, L</assert_multi_line>, |
2587
|
|
|
|
|
|
|
L</assert_nonalphabetic>, L</assert_nonascii>, L</assert_nonblank>, |
2588
|
|
|
|
|
|
|
L</assert_nonbytes>, L</assert_nonempty>, L</assert_single_line>, |
2589
|
|
|
|
|
|
|
L</assert_single_paragraph>, and L</assert_wide_characters>. |
2590
|
|
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
=item C<:tie> |
2592
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
L</assert_tied>, L</assert_tied_array>, L</assert_tied_arrayref>, |
2594
|
|
|
|
|
|
|
L</assert_tied_glob>, L</assert_tied_globref>, L</assert_tied_hash>, |
2595
|
|
|
|
|
|
|
L</assert_tied_hashref>, L</assert_tied_referent>, L</assert_tied_scalar>, |
2596
|
|
|
|
|
|
|
L</assert_tied_scalarref>, L</assert_untied>, L</assert_untied_array>, |
2597
|
|
|
|
|
|
|
L</assert_untied_arrayref>, L</assert_untied_glob>, |
2598
|
|
|
|
|
|
|
L</assert_untied_globref>, L</assert_untied_hash>, |
2599
|
|
|
|
|
|
|
L</assert_untied_hashref>, L</assert_untied_referent>, |
2600
|
|
|
|
|
|
|
L</assert_untied_scalar>, and L</assert_untied_scalarref>. |
2601
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
=item C<:unicode> |
2603
|
|
|
|
|
|
|
|
2604
|
|
|
|
|
|
|
L</assert_astral>, L</assert_bmp>, L</assert_eq>, L</assert_eq_letters>, |
2605
|
|
|
|
|
|
|
L</assert_latin1>, L</assert_latinish>, L</assert_nfc>, L</assert_nfd>, |
2606
|
|
|
|
|
|
|
L</assert_nfkc>, L</assert_nfkd>, and L</assert_nonastral>. |
2607
|
|
|
|
|
|
|
|
2608
|
|
|
|
|
|
|
=back |
2609
|
|
|
|
|
|
|
|
2610
|
|
|
|
|
|
|
=head2 Assertions about Calling Context |
2611
|
|
|
|
|
|
|
|
2612
|
|
|
|
|
|
|
These assertions inspect their immediate caller’s C<wantarray>. |
2613
|
|
|
|
|
|
|
|
2614
|
|
|
|
|
|
|
=over |
2615
|
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
|
=item assert_list_context() |
2617
|
|
|
|
|
|
|
|
2618
|
|
|
|
|
|
|
Current function was called in list context. |
2619
|
|
|
|
|
|
|
|
2620
|
|
|
|
|
|
|
=item assert_nonlist_context() |
2621
|
|
|
|
|
|
|
|
2622
|
|
|
|
|
|
|
Current function was I<not> called in list context. |
2623
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
=item assert_scalar_context() |
2625
|
|
|
|
|
|
|
|
2626
|
|
|
|
|
|
|
Current function was called in scalar context. |
2627
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
=item assert_void_context() |
2629
|
|
|
|
|
|
|
|
2630
|
|
|
|
|
|
|
Current function was called in void context. |
2631
|
|
|
|
|
|
|
|
2632
|
|
|
|
|
|
|
=item assert_nonvoid_context() |
2633
|
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
|
Current function was I<not> called in void context. |
2635
|
|
|
|
|
|
|
|
2636
|
|
|
|
|
|
|
=back |
2637
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
=head2 Assertions about Scalars |
2639
|
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
|
These assertions don't pay any special attention to objects, so the normal |
2641
|
|
|
|
|
|
|
effects of evaluating an object where a regular scalar is expected apply. |
2642
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
=over |
2644
|
|
|
|
|
|
|
|
2645
|
|
|
|
|
|
|
=item assert_true(I<EXPR>) |
2646
|
|
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
The scalar expression I<EXPR> is true according to Perl's sense of Boolean |
2648
|
|
|
|
|
|
|
logic, the sort of thing you would put in an C<if (...)> condition to have |
2649
|
|
|
|
|
|
|
its block run. |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
If this assertion fails, it will not report the original expression. You |
2652
|
|
|
|
|
|
|
should therefore strongly consider using L</assert_happy_code> instead for |
2653
|
|
|
|
|
|
|
more descriptive error messages because L</assert_happy_code> will show the |
2654
|
|
|
|
|
|
|
literal expression that was expected to be true but which unexpectedly |
2655
|
|
|
|
|
|
|
evaluated to false. |
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
=item assert_false(I<EXPR>) |
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
The scalar expression I<EXPR> is true according to Perl's sense of Boolean |
2660
|
|
|
|
|
|
|
logic, the sort of thing you would put in an C<unless>) condition to have |
2661
|
|
|
|
|
|
|
its block run. |
2662
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
If this assertion fails, it will not report the original expression. You |
2664
|
|
|
|
|
|
|
should therefore strongly consider using L</assert_unhappy_code> instead |
2665
|
|
|
|
|
|
|
for more descriptive error messages, because L</assert_unhappy_code> will |
2666
|
|
|
|
|
|
|
display the literal expression that was expected to be false but which |
2667
|
|
|
|
|
|
|
unexpectedly evaluated to true. |
2668
|
|
|
|
|
|
|
|
2669
|
|
|
|
|
|
|
False values in Perl are the undefined value, both kinds of empty string |
2670
|
|
|
|
|
|
|
(C<q()> and C<!1>), the string of length one whose only character is an |
2671
|
|
|
|
|
|
|
ASCII C<DIGIT ZERO>, and those numbers which evaluate to zero. Strings |
2672
|
|
|
|
|
|
|
that evaluate to numeric zero other than the previously stated exemption |
2673
|
|
|
|
|
|
|
are not false, such as the notorious value C<"0 but true"> sometimes |
2674
|
|
|
|
|
|
|
returned by the C<ioctl>, C<fcntl>, and C<syscall> system calls. |
2675
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
=item assert_defined(I<EXPR>) |
2677
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
The scalar I<EXPR> argument is defined. Consider using one of either |
2679
|
|
|
|
|
|
|
L</assert_defined_variable> or L</assert_defined_value> to better |
2680
|
|
|
|
|
|
|
document your intention. |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
=item assert_undefined(I<EXPR>) |
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
The scalar I<EXPR> argument is not defined. |
2685
|
|
|
|
|
|
|
|
2686
|
|
|
|
|
|
|
=item assert_defined_variable(I<SCALAR>) |
2687
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
The scalar B<variable> argument I<SCALAR> is defined. This is safer to |
2689
|
|
|
|
|
|
|
call than L</assert_defined_value> because it requires an actual scalar |
2690
|
|
|
|
|
|
|
variable with a leading dollar sign, so generates a compiler error if you |
2691
|
|
|
|
|
|
|
try to pass it other sigils. |
2692
|
|
|
|
|
|
|
|
2693
|
|
|
|
|
|
|
=item assert_defined_value(I<EXPR>) |
2694
|
|
|
|
|
|
|
|
2695
|
|
|
|
|
|
|
The scalar I<EXPR> is defined. |
2696
|
|
|
|
|
|
|
|
2697
|
|
|
|
|
|
|
=item assert_is(I<THIS>, I<THAT>) |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
The two defined non-ref arguments test true for "string equality", codepoint |
2700
|
|
|
|
|
|
|
by codepoint, using the built-in C<eq> operator. |
2701
|
|
|
|
|
|
|
|
2702
|
|
|
|
|
|
|
When called on objects with operator overloads, their C<eq> overload or if |
2703
|
|
|
|
|
|
|
necessary their stringification overloads will thereofre be honored but |
2704
|
|
|
|
|
|
|
this test is not otherwise in any fashion recursive or object-aware. |
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
This is not the same as equivalent Unicode strings. For that, use |
2707
|
|
|
|
|
|
|
L</assert_eq> to compare normalized Unicode strings, and use |
2708
|
|
|
|
|
|
|
L</assert_eq_letters> to compare only their letters but disregard the rest. |
2709
|
|
|
|
|
|
|
|
2710
|
|
|
|
|
|
|
=item assert_isnt(I<THIS>, I<THAT>) |
2711
|
|
|
|
|
|
|
|
2712
|
|
|
|
|
|
|
The two defined non-ref arguments test false for string equality with the |
2713
|
|
|
|
|
|
|
C<ne> operator. The expected overloads are therefore honored, but this |
2714
|
|
|
|
|
|
|
test is not otherwise in any fashion recursive or object-aware. |
2715
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
=back |
2717
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
=head2 Assertions about Numbers |
2719
|
|
|
|
|
|
|
|
2720
|
|
|
|
|
|
|
Most of the assertions in this section treat their arguments as numbers. |
2721
|
|
|
|
|
|
|
When called on objects with operator overloads, their evaluation will |
2722
|
|
|
|
|
|
|
therefore trigger a C<0+> nummification overload in preference to a C<""> |
2723
|
|
|
|
|
|
|
stringification overload if the former exists. Otherwise normal fallback |
2724
|
|
|
|
|
|
|
rules apply as documented in the L<overload> pragma. |
2725
|
|
|
|
|
|
|
|
2726
|
|
|
|
|
|
|
=over |
2727
|
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
=item assert_numeric(I<EXPR>) |
2729
|
|
|
|
|
|
|
|
2730
|
|
|
|
|
|
|
The defined non-ref argument looks like a number suitable for implicit |
2731
|
|
|
|
|
|
|
conversion according to the builtin L<Scalar::Util/looks_like_number> |
2732
|
|
|
|
|
|
|
predicate. |
2733
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
=item assert_nonnumeric(I<EXPR>) |
2735
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
The defined non-ref argument does I<not> look like a number suitable for |
2737
|
|
|
|
|
|
|
implicit conversion, again per L<Scalar::Util/looks_like_number>. |
2738
|
|
|
|
|
|
|
|
2739
|
|
|
|
|
|
|
=item assert_positive(I<EXPR>) |
2740
|
|
|
|
|
|
|
|
2741
|
|
|
|
|
|
|
The defined non-ref argument is numerically greater than zero. |
2742
|
|
|
|
|
|
|
|
2743
|
|
|
|
|
|
|
=item assert_nonpositive(I<EXPR>) |
2744
|
|
|
|
|
|
|
|
2745
|
|
|
|
|
|
|
The defined non-ref argument is numerically less than or equal to zero. |
2746
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
=item assert_negative(I<EXPR>) |
2748
|
|
|
|
|
|
|
|
2749
|
|
|
|
|
|
|
The defined non-ref argument is numerically less than zero. |
2750
|
|
|
|
|
|
|
|
2751
|
|
|
|
|
|
|
=item assert_nonnegative(I<EXPR>) |
2752
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
The defined non-ref argument is numerically greater than or equal to |
2754
|
|
|
|
|
|
|
numeric zero. |
2755
|
|
|
|
|
|
|
|
2756
|
|
|
|
|
|
|
=item assert_zero(I<EXPR>) |
2757
|
|
|
|
|
|
|
|
2758
|
|
|
|
|
|
|
The defined non-ref argument is numerically equal to numeric zero. |
2759
|
|
|
|
|
|
|
|
2760
|
|
|
|
|
|
|
=item assert_nonzero(I<EXPR>) |
2761
|
|
|
|
|
|
|
|
2762
|
|
|
|
|
|
|
The defined non-ref argument is not numerically equal to numeric zero. |
2763
|
|
|
|
|
|
|
|
2764
|
|
|
|
|
|
|
=item assert_integer(I<EXPR>) |
2765
|
|
|
|
|
|
|
|
2766
|
|
|
|
|
|
|
The defined non-ref numeric argument has no fractional part. |
2767
|
|
|
|
|
|
|
|
2768
|
|
|
|
|
|
|
=item assert_fractional(I<EXPR>) |
2769
|
|
|
|
|
|
|
|
2770
|
|
|
|
|
|
|
The defined non-ref numeric argument has a fractional part. |
2771
|
|
|
|
|
|
|
|
2772
|
|
|
|
|
|
|
=item assert_signed_number(I<EXPR>) |
2773
|
|
|
|
|
|
|
|
2774
|
|
|
|
|
|
|
The defined non-ref numeric argument has a leading sign, ASCII C<-> or |
2775
|
|
|
|
|
|
|
C<+>. A Unicode C<MINUS SIGN> does not currently count because Perl will |
2776
|
|
|
|
|
|
|
not respect it for implicit string-to-number conversions. |
2777
|
|
|
|
|
|
|
|
2778
|
|
|
|
|
|
|
=item assert_natural_number(I<EXPR>) |
2779
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
One of the counting numbers: 1, 2, 3, . . . |
2781
|
|
|
|
|
|
|
|
2782
|
|
|
|
|
|
|
=item assert_whole_number(I<EXPR>) |
2783
|
|
|
|
|
|
|
|
2784
|
|
|
|
|
|
|
A natural number or zero. |
2785
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
=item assert_positive_integer(I<EXPR>) |
2787
|
|
|
|
|
|
|
|
2788
|
|
|
|
|
|
|
An integer greater than zero. |
2789
|
|
|
|
|
|
|
|
2790
|
|
|
|
|
|
|
=item assert_nonpositive_integer(I<EXPR>) |
2791
|
|
|
|
|
|
|
|
2792
|
|
|
|
|
|
|
An integer not greater than zero. |
2793
|
|
|
|
|
|
|
|
2794
|
|
|
|
|
|
|
=item assert_negative_integer(I<EXPR>) |
2795
|
|
|
|
|
|
|
|
2796
|
|
|
|
|
|
|
An integer less than zero. |
2797
|
|
|
|
|
|
|
|
2798
|
|
|
|
|
|
|
=item assert_nonnegative_integer(I<EXPR>) |
2799
|
|
|
|
|
|
|
|
2800
|
|
|
|
|
|
|
An integer that's zero or below. |
2801
|
|
|
|
|
|
|
|
2802
|
|
|
|
|
|
|
=item assert_hex_number(I<EXPR>) |
2803
|
|
|
|
|
|
|
|
2804
|
|
|
|
|
|
|
Beyond an optional leading C<0x>, the argument contains only ASCII hex |
2805
|
|
|
|
|
|
|
digits, making it suitable for feeding to the C<hex> function. |
2806
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
=item assert_box_number(I<EXPR>) |
2808
|
|
|
|
|
|
|
|
2809
|
|
|
|
|
|
|
The argument treated as a I<string> is suitable for feeding to Perl's |
2810
|
|
|
|
|
|
|
C<oct> function, so a non-negative integer with an optional leading C<0b> |
2811
|
|
|
|
|
|
|
for binary, C<0o> or C<0> for octal, or C<0x> for hex. |
2812
|
|
|
|
|
|
|
|
2813
|
|
|
|
|
|
|
Mnemonic: "I<box> numbers" are B<b>inary, B<o>ctal, or heB<x> numbers. |
2814
|
|
|
|
|
|
|
|
2815
|
|
|
|
|
|
|
=item assert_even_number(I<EXPR>) |
2816
|
|
|
|
|
|
|
|
2817
|
|
|
|
|
|
|
The defined non-ref integer expression must be an even multiple of two. |
2818
|
|
|
|
|
|
|
|
2819
|
|
|
|
|
|
|
=item assert_odd_number(I<EXPR>) |
2820
|
|
|
|
|
|
|
|
2821
|
|
|
|
|
|
|
The defined non-ref integer expression must I<not> be an even multiple of two. |
2822
|
|
|
|
|
|
|
|
2823
|
|
|
|
|
|
|
=item assert_in_numeric_range(I<NUMBER>, I<LOW>, I<HIGH>) |
2824
|
|
|
|
|
|
|
|
2825
|
|
|
|
|
|
|
The scalar I<NUMBER> argument falls between the numeric range specified in |
2826
|
|
|
|
|
|
|
the next two scalar arguments; that is, it must be at least as great as the |
2827
|
|
|
|
|
|
|
I<LOW> end of the range but no higher than the I<HIGH> end of the range. |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
It's like writing either of these: |
2830
|
|
|
|
|
|
|
|
2831
|
|
|
|
|
|
|
assert_happy_code { $number >= $low && $number <= $high }; |
2832
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
assert_true($number >= $low && $number <= $high); |
2834
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
=back |
2836
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
=head2 Assertions about Strings |
2838
|
|
|
|
|
|
|
|
2839
|
|
|
|
|
|
|
=over |
2840
|
|
|
|
|
|
|
|
2841
|
|
|
|
|
|
|
=item assert_empty(I<EXPR>) |
2842
|
|
|
|
|
|
|
|
2843
|
|
|
|
|
|
|
The defined non-ref argument is of zero length. |
2844
|
|
|
|
|
|
|
|
2845
|
|
|
|
|
|
|
=item assert_nonempty(I<EXPR>) |
2846
|
|
|
|
|
|
|
|
2847
|
|
|
|
|
|
|
The defined non-ref argument is not of zero length. |
2848
|
|
|
|
|
|
|
|
2849
|
|
|
|
|
|
|
=item assert_blank(I<EXPR>) |
2850
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
The defined non-ref argument has at most only whitespace |
2852
|
|
|
|
|
|
|
characters in it. It may be length zero. |
2853
|
|
|
|
|
|
|
|
2854
|
|
|
|
|
|
|
=item assert_nonblank(I<EXPR>) |
2855
|
|
|
|
|
|
|
|
2856
|
|
|
|
|
|
|
The defined non-ref argument has at least one non-whitespace |
2857
|
|
|
|
|
|
|
character in it. |
2858
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
=item assert_single_line(I<EXPR>) |
2860
|
|
|
|
|
|
|
|
2861
|
|
|
|
|
|
|
The defined non-empty string argument has at most one optional linebreak grapheme |
2862
|
|
|
|
|
|
|
(C<\R>, so a CRLF or vertical whitespace line newline, carriage return, and |
2863
|
|
|
|
|
|
|
form feed) at the very end. It is disqualified if it has a linebreak |
2864
|
|
|
|
|
|
|
anywhere shy of the end, or more than one of them at the end. |
2865
|
|
|
|
|
|
|
|
2866
|
|
|
|
|
|
|
=item assert_multi_line(I<EXPR>) |
2867
|
|
|
|
|
|
|
|
2868
|
|
|
|
|
|
|
Non-empty string argument has at most one optional linebreak grapheme |
2869
|
|
|
|
|
|
|
(C<\R>, so a CRLF or vertical whitespace line newline, carriage return, and |
2870
|
|
|
|
|
|
|
form feed) at the very end. It is disqualified if it has a linebreak |
2871
|
|
|
|
|
|
|
anywhere shy of the end, or more than one of them at the end. |
2872
|
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
|
=item assert_single_paragraph(I<EXPR>) |
2874
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
Non-empty string argument has at any number of linebreak graphemes |
2876
|
|
|
|
|
|
|
at the very end only. It is disqualified if it has linebreaks |
2877
|
|
|
|
|
|
|
anywhere shy of the end, but does not care how many are there. |
2878
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
=item assert_bytes(I<EXPR>) |
2880
|
|
|
|
|
|
|
|
2881
|
|
|
|
|
|
|
Argument contains only code points between 0x00 and 0xFF. |
2882
|
|
|
|
|
|
|
Such data is suitable for writing out as binary bytes. |
2883
|
|
|
|
|
|
|
|
2884
|
|
|
|
|
|
|
=item assert_nonbytes(I<EXPR>) |
2885
|
|
|
|
|
|
|
|
2886
|
|
|
|
|
|
|
Argument contains code points greater than 0xFF. |
2887
|
|
|
|
|
|
|
Such data must first be encoded when written. |
2888
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
=item assert_wide_characters(I<EXPR>) |
2890
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
The same thing as saying that it contains non-bytes. |
2892
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
=back |
2894
|
|
|
|
|
|
|
|
2895
|
|
|
|
|
|
|
=head2 Assertions about Regexes |
2896
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
=over |
2898
|
|
|
|
|
|
|
|
2899
|
|
|
|
|
|
|
=item assert_nonascii(I<EXPR>) |
2900
|
|
|
|
|
|
|
|
2901
|
|
|
|
|
|
|
Argument contains at least one code point larger that 127. |
2902
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
=item assert_ascii(I<EXPR>) |
2904
|
|
|
|
|
|
|
|
2905
|
|
|
|
|
|
|
Argument contains only code points less than 128. |
2906
|
|
|
|
|
|
|
|
2907
|
|
|
|
|
|
|
=item assert_alphabetic(I<EXPR>) |
2908
|
|
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
Argument contains only alphabetic code points, |
2910
|
|
|
|
|
|
|
but not necessarily ASCII ones. |
2911
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
=item assert_nonalphabetic(I<EXPR>) |
2913
|
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
Argument contains only non-alphabetic code points, |
2915
|
|
|
|
|
|
|
but not necessarily ASCII ones. |
2916
|
|
|
|
|
|
|
|
2917
|
|
|
|
|
|
|
=item assert_alnum(I<EXPR>) |
2918
|
|
|
|
|
|
|
|
2919
|
|
|
|
|
|
|
Argument contains only alphabetic or numeric code points, |
2920
|
|
|
|
|
|
|
but not necessarily ASCII ones. |
2921
|
|
|
|
|
|
|
|
2922
|
|
|
|
|
|
|
=item assert_digits(I<EXPR>) |
2923
|
|
|
|
|
|
|
|
2924
|
|
|
|
|
|
|
Argument contains only ASCII digits. |
2925
|
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
|
=item assert_uppercased(I<EXPR>) |
2927
|
|
|
|
|
|
|
|
2928
|
|
|
|
|
|
|
Argument will not change if uppercased. |
2929
|
|
|
|
|
|
|
|
2930
|
|
|
|
|
|
|
=item assert_lowercased(I<EXPR>) |
2931
|
|
|
|
|
|
|
|
2932
|
|
|
|
|
|
|
Argument will not change if lowercased. |
2933
|
|
|
|
|
|
|
|
2934
|
|
|
|
|
|
|
=item assert_unicode_ident(I<EXPR>) |
2935
|
|
|
|
|
|
|
|
2936
|
|
|
|
|
|
|
Argument is a legal Unicode identifier, so one beginning with an (X)ID Start |
2937
|
|
|
|
|
|
|
code point and having any number of (X)ID Continue code points following. |
2938
|
|
|
|
|
|
|
Note that Perl identifiers are somewhat different from this. |
2939
|
|
|
|
|
|
|
|
2940
|
|
|
|
|
|
|
=item assert_simple_perl_ident(I<EXPR>) |
2941
|
|
|
|
|
|
|
|
2942
|
|
|
|
|
|
|
Like a Unicode identifier but which may also start |
2943
|
|
|
|
|
|
|
with connector punctuation like underscores. No package |
2944
|
|
|
|
|
|
|
separators are allowed, however. Sigils do not count. |
2945
|
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
|
Also, special variables like C<$.> or C<${^PREMATCH}> |
2947
|
|
|
|
|
|
|
will not work either, since passing this function |
2948
|
|
|
|
|
|
|
strings like C<.> and C<{> and C<^> are |
2949
|
|
|
|
|
|
|
all beyond the pale. |
2950
|
|
|
|
|
|
|
|
2951
|
|
|
|
|
|
|
=item assert_full_perl_ident(I<EXPR>) |
2952
|
|
|
|
|
|
|
|
2953
|
|
|
|
|
|
|
Like a simple Perl identifier but which also |
2954
|
|
|
|
|
|
|
allows for optional package separators, |
2955
|
|
|
|
|
|
|
either C<::> or C<'>. |
2956
|
|
|
|
|
|
|
|
2957
|
|
|
|
|
|
|
=item assert_qualified_ident(I<EXPR>) |
2958
|
|
|
|
|
|
|
|
2959
|
|
|
|
|
|
|
Like a full Perl identifier but with |
2960
|
|
|
|
|
|
|
mandatory package separators, either C<::> or C<'>. |
2961
|
|
|
|
|
|
|
|
2962
|
|
|
|
|
|
|
=item assert_ascii_ident(I<EXPR>) |
2963
|
|
|
|
|
|
|
|
2964
|
|
|
|
|
|
|
What most people think of as an identifier, |
2965
|
|
|
|
|
|
|
one with only ASCII letter, digits, and underscores, |
2966
|
|
|
|
|
|
|
and which cannot begin with a digit. |
2967
|
|
|
|
|
|
|
|
2968
|
|
|
|
|
|
|
=item assert_regex(I<ARG>) |
2969
|
|
|
|
|
|
|
|
2970
|
|
|
|
|
|
|
The argument must be a compile Regexp object. |
2971
|
|
|
|
|
|
|
|
2972
|
|
|
|
|
|
|
=item assert_like(I<STRING>, I<REGEX>) |
2973
|
|
|
|
|
|
|
|
2974
|
|
|
|
|
|
|
The string, which must be a defined non-reference, |
2975
|
|
|
|
|
|
|
matches the pattern, which must be a compiled Regexp object |
2976
|
|
|
|
|
|
|
produces by the C<qr> operator. |
2977
|
|
|
|
|
|
|
|
2978
|
|
|
|
|
|
|
=item assert_unlike(I<STRING>, I<REGEX>) |
2979
|
|
|
|
|
|
|
|
2980
|
|
|
|
|
|
|
The string, which must be a defined non-reference, |
2981
|
|
|
|
|
|
|
cannot match the pattern, which must be a compiled Regexp object |
2982
|
|
|
|
|
|
|
produces by the C<qr> operator. |
2983
|
|
|
|
|
|
|
|
2984
|
|
|
|
|
|
|
=back |
2985
|
|
|
|
|
|
|
|
2986
|
|
|
|
|
|
|
=head2 Assertions about Unicode |
2987
|
|
|
|
|
|
|
|
2988
|
|
|
|
|
|
|
=over |
2989
|
|
|
|
|
|
|
|
2990
|
|
|
|
|
|
|
=item assert_latin1(I<ARG>) |
2991
|
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
|
The argument contains only code points |
2993
|
|
|
|
|
|
|
from U+0000 through U+00FF. |
2994
|
|
|
|
|
|
|
|
2995
|
|
|
|
|
|
|
=item assert_latinish(I<ARG>) |
2996
|
|
|
|
|
|
|
|
2997
|
|
|
|
|
|
|
The argument contains only characters from the |
2998
|
|
|
|
|
|
|
Latin, Common, or Inherited scripts. |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
=item assert_astral(I<ARG>) |
3001
|
|
|
|
|
|
|
|
3002
|
|
|
|
|
|
|
The argument contains at least one code point larger |
3003
|
|
|
|
|
|
|
than U+FFFF, so those above Plane 0. |
3004
|
|
|
|
|
|
|
|
3005
|
|
|
|
|
|
|
=item assert_nonastral(I<ARG>) |
3006
|
|
|
|
|
|
|
|
3007
|
|
|
|
|
|
|
Argument contains only code points |
3008
|
|
|
|
|
|
|
from U+0000 through U+FFFF. |
3009
|
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
=item assert_bmp(I<ARG>) |
3011
|
|
|
|
|
|
|
|
3012
|
|
|
|
|
|
|
An alias for L</assert_nonastral>. |
3013
|
|
|
|
|
|
|
|
3014
|
|
|
|
|
|
|
The argument contains only code points in the |
3015
|
|
|
|
|
|
|
Basic Multilingual Plain; that is, in Plane 0. |
3016
|
|
|
|
|
|
|
|
3017
|
|
|
|
|
|
|
=item assert_nfc(I<ARG>) |
3018
|
|
|
|
|
|
|
|
3019
|
|
|
|
|
|
|
The argument is in Unicode Normalization Form C, |
3020
|
|
|
|
|
|
|
formed by canonical I<B<de>composition> followed by |
3021
|
|
|
|
|
|
|
canonical composition. |
3022
|
|
|
|
|
|
|
|
3023
|
|
|
|
|
|
|
=item assert_nfkc(I<ARG>) |
3024
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
The argument is in Unicode Normalization Form KC, |
3026
|
|
|
|
|
|
|
formed by compatible I<B<de>composition> followed by |
3027
|
|
|
|
|
|
|
compatible composition. |
3028
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
=item assert_nfd(I<ARG>) |
3030
|
|
|
|
|
|
|
|
3031
|
|
|
|
|
|
|
The argument is in Unicode Normalization Form D, |
3032
|
|
|
|
|
|
|
formed by canonical I<B<de>composition>. |
3033
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
=item assert_nfkd(I<ARG>) |
3035
|
|
|
|
|
|
|
|
3036
|
|
|
|
|
|
|
The argument is in Unicode Normalization Form KD, |
3037
|
|
|
|
|
|
|
formed by compatible I<B<de>composition>. |
3038
|
|
|
|
|
|
|
|
3039
|
|
|
|
|
|
|
=item assert_eq(I<THIS>, I<THAT>) |
3040
|
|
|
|
|
|
|
|
3041
|
|
|
|
|
|
|
The two strings have the same NFC forms using the C<eq> |
3042
|
|
|
|
|
|
|
operator. This means that default ignorable code points |
3043
|
|
|
|
|
|
|
will throw of the equality check. |
3044
|
|
|
|
|
|
|
|
3045
|
|
|
|
|
|
|
This is not the same as L</assert_is>. You may well |
3046
|
|
|
|
|
|
|
want the next assertion instead. |
3047
|
|
|
|
|
|
|
|
3048
|
|
|
|
|
|
|
=item assert_eq_letters(I<THIS>, I<THAT>) |
3049
|
|
|
|
|
|
|
|
3050
|
|
|
|
|
|
|
The two strings test equal when considered only at the primary strength |
3051
|
|
|
|
|
|
|
(letters only) using the Unicode Collation Algorithm. That means that case |
3052
|
|
|
|
|
|
|
(whether upper-, lower-, or titecase), non-letters, and combining marks are |
3053
|
|
|
|
|
|
|
ignored, as are other default ignorable code points. |
3054
|
|
|
|
|
|
|
|
3055
|
|
|
|
|
|
|
=back |
3056
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
=head2 Assertions about Lists |
3058
|
|
|
|
|
|
|
|
3059
|
|
|
|
|
|
|
=over |
3060
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
=item assert_in_list(I<STRING>, I<LIST>) |
3062
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
The first argument must occur in the list following it. |
3064
|
|
|
|
|
|
|
|
3065
|
|
|
|
|
|
|
=item assert_not_in_list(I<STRING>, I<LIST>) |
3066
|
|
|
|
|
|
|
|
3067
|
|
|
|
|
|
|
The first argument must not occur in the list following it. |
3068
|
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
|
=item assert_list_nonempty(I<LIST>) |
3070
|
|
|
|
|
|
|
|
3071
|
|
|
|
|
|
|
The list must have at least one element, although that |
3072
|
|
|
|
|
|
|
element does not have to nonblank or even defined. |
3073
|
|
|
|
|
|
|
|
3074
|
|
|
|
|
|
|
=back |
3075
|
|
|
|
|
|
|
|
3076
|
|
|
|
|
|
|
=head2 Assertions about Arrays |
3077
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
=over |
3079
|
|
|
|
|
|
|
|
3080
|
|
|
|
|
|
|
=item assert_array_nonempty( I<ARRAY> ) |
3081
|
|
|
|
|
|
|
|
3082
|
|
|
|
|
|
|
The array must at least one element. |
3083
|
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
|
=item assert_arrayref_nonempty( I<ARRAYREF> ) |
3085
|
|
|
|
|
|
|
|
3086
|
|
|
|
|
|
|
The array reference must refer to an existing array with |
3087
|
|
|
|
|
|
|
at least one element. |
3088
|
|
|
|
|
|
|
|
3089
|
|
|
|
|
|
|
=item assert_array_length(I<ARRAY>, [ I<LENGTH> ]) |
3090
|
|
|
|
|
|
|
|
3091
|
|
|
|
|
|
|
The array must have the number of elements specified |
3092
|
|
|
|
|
|
|
in the optional second argument. If the second |
3093
|
|
|
|
|
|
|
argument is omitted, any non-zero length will do. |
3094
|
|
|
|
|
|
|
|
3095
|
|
|
|
|
|
|
=item assert_array_length_min(I<ARRAY>, I<MIN_ELEMENTS>) |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
The array must have at least as many elements as specified |
3098
|
|
|
|
|
|
|
by the number in the second argument. |
3099
|
|
|
|
|
|
|
|
3100
|
|
|
|
|
|
|
=item assert_array_length_max(I<ARRAY>, I<MAX_ELEMENTS>) |
3101
|
|
|
|
|
|
|
|
3102
|
|
|
|
|
|
|
The array must have no more elements than the number specified |
3103
|
|
|
|
|
|
|
in the second argument. |
3104
|
|
|
|
|
|
|
|
3105
|
|
|
|
|
|
|
=item assert_array_length_minmax(I<ARRAY>, I<MIN_ELEMENTS>, I<MAX_ELEMENTS>) |
3106
|
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
|
The array must have at least as many elements as the number given in the |
3108
|
|
|
|
|
|
|
second element, but no more than the one in the third. |
3109
|
|
|
|
|
|
|
|
3110
|
|
|
|
|
|
|
=back |
3111
|
|
|
|
|
|
|
|
3112
|
|
|
|
|
|
|
=head2 Assertions about Argument Counts |
3113
|
|
|
|
|
|
|
|
3114
|
|
|
|
|
|
|
B<WARNING:> These assertions are incompatible with L<Test::Exception> because |
3115
|
|
|
|
|
|
|
they inspect their C<caller>'s args via C<@DB::args>, and that module wipes |
3116
|
|
|
|
|
|
|
those out from visibility. |
3117
|
|
|
|
|
|
|
|
3118
|
|
|
|
|
|
|
=over |
3119
|
|
|
|
|
|
|
|
3120
|
|
|
|
|
|
|
=item assert_argc() |
3121
|
|
|
|
|
|
|
|
3122
|
|
|
|
|
|
|
=item assert_argc(I<COUNT>) |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
=for comment |
3125
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3126
|
|
|
|
|
|
|
|
3127
|
|
|
|
|
|
|
Z<> |
3128
|
|
|
|
|
|
|
|
3129
|
|
|
|
|
|
|
assert_argc(3); # must be exactly 3 args |
3130
|
|
|
|
|
|
|
assert_argc( ); # must be at least 1 arg |
3131
|
|
|
|
|
|
|
|
3132
|
|
|
|
|
|
|
The function must have been passed the number of arguments specified in the |
3133
|
|
|
|
|
|
|
optional I<COUNT> argument. When called without a I<COUNT> argument, any |
3134
|
|
|
|
|
|
|
non-zero number of arguments will do. |
3135
|
|
|
|
|
|
|
|
3136
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3137
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
=item assert_argc_min(I<COUNT>) |
3139
|
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
The function must have been passed at I<least> as many arguments as |
3141
|
|
|
|
|
|
|
specified in the I<COUNT> argument. |
3142
|
|
|
|
|
|
|
|
3143
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3144
|
|
|
|
|
|
|
|
3145
|
|
|
|
|
|
|
=item assert_argc_max(I<COUNT>) |
3146
|
|
|
|
|
|
|
|
3147
|
|
|
|
|
|
|
The function must have been passed at I<most> as arguments as specified in |
3148
|
|
|
|
|
|
|
the I<COUNT> argument. |
3149
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3151
|
|
|
|
|
|
|
|
3152
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3153
|
|
|
|
|
|
|
|
3154
|
|
|
|
|
|
|
=item assert_argc_minmax(I<MIN>, I<MAX>) |
3155
|
|
|
|
|
|
|
|
3156
|
|
|
|
|
|
|
The function must have been passed at least as many arguments as |
3157
|
|
|
|
|
|
|
specified by the I<MIN>, but no more than specified in the I<MAX>. |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3160
|
|
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
=back |
3162
|
|
|
|
|
|
|
|
3163
|
|
|
|
|
|
|
=head2 Assertions about Hashes |
3164
|
|
|
|
|
|
|
|
3165
|
|
|
|
|
|
|
=over |
3166
|
|
|
|
|
|
|
|
3167
|
|
|
|
|
|
|
=item assert_hash_nonempty(I<HASH>) |
3168
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
The hash must have at least one key. |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
=item assert_hashref_nonempty(I<HASHREF>) |
3172
|
|
|
|
|
|
|
|
3173
|
|
|
|
|
|
|
The hashref's referent must have at least one key. |
3174
|
|
|
|
|
|
|
|
3175
|
|
|
|
|
|
|
=item assert_keys(I<HASH> | I<HASHREF>, I<KEY_LIST>) |
3176
|
|
|
|
|
|
|
|
3177
|
|
|
|
|
|
|
=for comment |
3178
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3179
|
|
|
|
|
|
|
|
3180
|
|
|
|
|
|
|
Z<> |
3181
|
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
|
my @exact_keys = qw[larry moe curly]; |
3183
|
|
|
|
|
|
|
assert_keys(%some_hash, @exact_keys); |
3184
|
|
|
|
|
|
|
|
3185
|
|
|
|
|
|
|
The I<HASH> must have all keys in the non-empty I<KEY_LIST> but no others. |
3186
|
|
|
|
|
|
|
|
3187
|
|
|
|
|
|
|
This is especially useful when you've got a hash that you're treating as a |
3188
|
|
|
|
|
|
|
"fixed record" data-type, as though it were a C C<struct>: all fields are |
3189
|
|
|
|
|
|
|
guaranteed to be present and nothing else. |
3190
|
|
|
|
|
|
|
|
3191
|
|
|
|
|
|
|
This assertion also accepts a I<HASHREF> argument instead, but it still |
3192
|
|
|
|
|
|
|
must be an actual variable. |
3193
|
|
|
|
|
|
|
|
3194
|
|
|
|
|
|
|
That is, if instead of a I<HASH> variable is passed as the first argument, |
3195
|
|
|
|
|
|
|
a scalar variable holding a hashref is passed, then the hash referenced is |
3196
|
|
|
|
|
|
|
subject to this constraint. In other words, you get a single level of |
3197
|
|
|
|
|
|
|
auto-dereference to get to the hash, but the price of that is that this |
3198
|
|
|
|
|
|
|
must be an lvalue not an rvalue: it must be an actual variable. For |
3199
|
|
|
|
|
|
|
example: |
3200
|
|
|
|
|
|
|
|
3201
|
|
|
|
|
|
|
my @exact_keys = qw[larry moe curly]; |
3202
|
|
|
|
|
|
|
|
3203
|
|
|
|
|
|
|
assert_keys($some_hashref, @exact_keys); |
3204
|
|
|
|
|
|
|
assert_keys($hash_of_hashes{SOME_FIELD}, @exact_keys); |
3205
|
|
|
|
|
|
|
assert_keys($array_of_hashes[42], @exact_keys); |
3206
|
|
|
|
|
|
|
|
3207
|
|
|
|
|
|
|
Perl enforces this at compile-time by making you use either |
3208
|
|
|
|
|
|
|
a C<%> or C<$> sigil on the first argument to this assertion. |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
For many uses of exact hashes like this, you would be well |
3211
|
|
|
|
|
|
|
advised to lock the hash keys once you've validated them. |
3212
|
|
|
|
|
|
|
|
3213
|
|
|
|
|
|
|
use Hash::Util qw(lock_keys); |
3214
|
|
|
|
|
|
|
my @exact_keys = qw[larry moe curly]; |
3215
|
|
|
|
|
|
|
assert_keys(%some_hash, @exact_keys); |
3216
|
|
|
|
|
|
|
lock_keys(%some_hash); |
3217
|
|
|
|
|
|
|
|
3218
|
|
|
|
|
|
|
or |
3219
|
|
|
|
|
|
|
|
3220
|
|
|
|
|
|
|
use Hash::Util qw(lock_ref_keys); |
3221
|
|
|
|
|
|
|
|
3222
|
|
|
|
|
|
|
my @exact_keys = qw[larry moe curly]; |
3223
|
|
|
|
|
|
|
assert_keys($some_hashref, @exact_keys); |
3224
|
|
|
|
|
|
|
lock_ref_keys($some_hashref); |
3225
|
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
Now the I<keys> are locked down to keep your honest, although |
3227
|
|
|
|
|
|
|
the I<values> can be still be changed. See L<Hash::Util>. |
3228
|
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
|
=item assert_min_keys(I<HASH> | I<HASHREF>, I<KEY_LIST>) |
3230
|
|
|
|
|
|
|
|
3231
|
|
|
|
|
|
|
=for comment |
3232
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3233
|
|
|
|
|
|
|
|
3234
|
|
|
|
|
|
|
Z<> |
3235
|
|
|
|
|
|
|
|
3236
|
|
|
|
|
|
|
assert_min_keys(%hash, qw[blue green red]); |
3237
|
|
|
|
|
|
|
assert_min_keys($hashref, qw[blue green red]); |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
Asserts that the hash or hashref argument contains at I<least> the keys |
3240
|
|
|
|
|
|
|
mentioned in the non-empty key list. |
3241
|
|
|
|
|
|
|
|
3242
|
|
|
|
|
|
|
=item assert_max_keys(I<HASH> | I<HASHREF>, I<KEY_LIST>) |
3243
|
|
|
|
|
|
|
|
3244
|
|
|
|
|
|
|
=for comment |
3245
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3246
|
|
|
|
|
|
|
|
3247
|
|
|
|
|
|
|
Z<> |
3248
|
|
|
|
|
|
|
|
3249
|
|
|
|
|
|
|
assert_max_keys(%hash, qw[violet indigo blue cyan green yellow orange red]); |
3250
|
|
|
|
|
|
|
assert_max_keys($hashref, qw[violet indigo blue cyan green yellow orange red]); |
3251
|
|
|
|
|
|
|
|
3252
|
|
|
|
|
|
|
Asserts that the hash or hashref argument contains at I<most> the keys |
3253
|
|
|
|
|
|
|
mentioned in the non-empty key list. Consider locking your hash instead of just |
3254
|
|
|
|
|
|
|
checking for unwanted keys. The locking will make sure that no other keys |
3255
|
|
|
|
|
|
|
than these can be added to the hash: |
3256
|
|
|
|
|
|
|
|
3257
|
|
|
|
|
|
|
lock_keys(%hash, qw[violet indigo blue cyan green yellow orange red]); |
3258
|
|
|
|
|
|
|
lock_keys_ref($hashref, qw[violet indigo blue cyan green yellow orange red]); |
3259
|
|
|
|
|
|
|
|
3260
|
|
|
|
|
|
|
Now you don't have to call L</assert_max_keys> at all. |
3261
|
|
|
|
|
|
|
|
3262
|
|
|
|
|
|
|
=item assert_minmax_keys(I<HASH> | I<HASHREF>, I<MIN_ARRAY> | I<MIN_ARRAYREF>, I<MAX_ARRAY> | I<MAX_ARRAYREF>) |
3263
|
|
|
|
|
|
|
|
3264
|
|
|
|
|
|
|
=for comment |
3265
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3266
|
|
|
|
|
|
|
|
3267
|
|
|
|
|
|
|
Z<> |
3268
|
|
|
|
|
|
|
|
3269
|
|
|
|
|
|
|
@minkeys = qw[red blue green]; |
3270
|
|
|
|
|
|
|
@maxkeys = (@minkeys, qw[orange yellow cyan indigo]); |
3271
|
|
|
|
|
|
|
|
3272
|
|
|
|
|
|
|
assert_minmax_keys(%hash, @minkeys, @maxkeys); |
3273
|
|
|
|
|
|
|
assert_minmax_keys($hashref, @minkeys, @maxkeys); |
3274
|
|
|
|
|
|
|
|
3275
|
|
|
|
|
|
|
Asserts that the hash or hashref argument contains no other keys than the |
3276
|
|
|
|
|
|
|
maximum allowed ones specified, and that all of those from the minimum |
3277
|
|
|
|
|
|
|
required set exist. The arguments must be actual variables (lvalues), |
3278
|
|
|
|
|
|
|
not merely anonymous values. |
3279
|
|
|
|
|
|
|
|
3280
|
|
|
|
|
|
|
You can also pass the two pairs of minimum and maximum keys as scalar |
3281
|
|
|
|
|
|
|
variables holding arrayrefs instead: |
3282
|
|
|
|
|
|
|
|
3283
|
|
|
|
|
|
|
$minkeyref = \@minkeys; |
3284
|
|
|
|
|
|
|
$maxkeyref = \@maxkeys; |
3285
|
|
|
|
|
|
|
|
3286
|
|
|
|
|
|
|
assert_minmax_keys(%hash, $minkeyref, $maxkeyref); |
3287
|
|
|
|
|
|
|
assert_minmax_keys($hashref, $minkeyref, $maxkeyref); |
3288
|
|
|
|
|
|
|
|
3289
|
|
|
|
|
|
|
@minmax = ($minkeyref, $maxkeyref); |
3290
|
|
|
|
|
|
|
|
3291
|
|
|
|
|
|
|
assert_minmax_keys(%hash, $minmax[0], $minmax[1]); |
3292
|
|
|
|
|
|
|
assert_minmax_keys($hashref, $minmax[0], $minmax[1]); |
3293
|
|
|
|
|
|
|
|
3294
|
|
|
|
|
|
|
If you're careful to pass three refs of the right sorts in, you can |
3295
|
|
|
|
|
|
|
actually use this if you circumvent prototype checking: |
3296
|
|
|
|
|
|
|
|
3297
|
|
|
|
|
|
|
&assert_minmax_keys(\%hash, @minmax); |
3298
|
|
|
|
|
|
|
&assert_minmax_keys( $hashref, @minmax); |
3299
|
|
|
|
|
|
|
|
3300
|
|
|
|
|
|
|
=item assert_locked(I<HASH> | I<HASHREF>) |
3301
|
|
|
|
|
|
|
|
3302
|
|
|
|
|
|
|
=for comment |
3303
|
|
|
|
|
|
|
This is a workaround to create a "blank" line. |
3304
|
|
|
|
|
|
|
|
3305
|
|
|
|
|
|
|
Z<> |
3306
|
|
|
|
|
|
|
|
3307
|
|
|
|
|
|
|
B<WARNING>: Only available under version 0.15 and greater of L<Hash::Util,> first found in perl v5.17. |
3308
|
|
|
|
|
|
|
|
3309
|
|
|
|
|
|
|
assert_locked(%hash); |
3310
|
|
|
|
|
|
|
assert_locked($hashref); |
3311
|
|
|
|
|
|
|
|
3312
|
|
|
|
|
|
|
assert_locked($array_of_hashes[0]); |
3313
|
|
|
|
|
|
|
assert_locked($arrayref_of_hashes->[0]); |
3314
|
|
|
|
|
|
|
|
3315
|
|
|
|
|
|
|
assert_locked($hash_of_hashes{FIELD}); |
3316
|
|
|
|
|
|
|
assert_locked($hashref_of_hashes->{FIELD}); |
3317
|
|
|
|
|
|
|
|
3318
|
|
|
|
|
|
|
The argument, which must be either a hash variable or else a scalar |
3319
|
|
|
|
|
|
|
variable holding a hashref, must have locked keys. |
3320
|
|
|
|
|
|
|
|
3321
|
|
|
|
|
|
|
=item assert_unlocked(I<HASH> | I<HASHREF>) |
3322
|
|
|
|
|
|
|
|
3323
|
|
|
|
|
|
|
=for comment |
3324
|
|
|
|
|
|
|
This is a workaround to create a "blank" line. |
3325
|
|
|
|
|
|
|
|
3326
|
|
|
|
|
|
|
Z<> |
3327
|
|
|
|
|
|
|
|
3328
|
|
|
|
|
|
|
B<WARNING>: Only available under version 0.15 and greater of L<Hash::Util>, first found in perl v5.17. |
3329
|
|
|
|
|
|
|
|
3330
|
|
|
|
|
|
|
assert_unlocked(%hash); |
3331
|
|
|
|
|
|
|
assert_unlocked($hashref); |
3332
|
|
|
|
|
|
|
|
3333
|
|
|
|
|
|
|
assert_unlocked($array_of_hashes[0]); |
3334
|
|
|
|
|
|
|
assert_unlocked($arrayref_of_hashes->[0]); |
3335
|
|
|
|
|
|
|
|
3336
|
|
|
|
|
|
|
assert_unlocked($hash_of_hashes{FIELD}); |
3337
|
|
|
|
|
|
|
assert_unlocked($hashref_of_hashes->{FIELD}); |
3338
|
|
|
|
|
|
|
|
3339
|
|
|
|
|
|
|
The argument, which must be either a hash variable or else a scalar |
3340
|
|
|
|
|
|
|
variable holding a hashref, must not have locked keys. |
3341
|
|
|
|
|
|
|
|
3342
|
|
|
|
|
|
|
=back |
3343
|
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
=head2 Legacy Assertions about Hashes |
3345
|
|
|
|
|
|
|
|
3346
|
|
|
|
|
|
|
You should usually prefer L</assert_keys>, L</assert_min_keys>, |
3347
|
|
|
|
|
|
|
L</assert_max_keys>, and L</assert_minmax_keys> over the assertions in this |
3348
|
|
|
|
|
|
|
section, since those have better names and aren't so finicky about their |
3349
|
|
|
|
|
|
|
first argument. The following assertions are retained for backwards |
3350
|
|
|
|
|
|
|
compatibility, but internally they all turn into one of those four. |
3351
|
|
|
|
|
|
|
|
3352
|
|
|
|
|
|
|
The thing to remember with these is that "required" keys really means I<at |
3353
|
|
|
|
|
|
|
B<least> these keys>, while "allowed" keys really means I<at B<most> these |
3354
|
|
|
|
|
|
|
keys>. If you need those to be the same set, then just use L</assert_keys> |
3355
|
|
|
|
|
|
|
directly. |
3356
|
|
|
|
|
|
|
|
3357
|
|
|
|
|
|
|
=over |
3358
|
|
|
|
|
|
|
|
3359
|
|
|
|
|
|
|
=item assert_hash_keys(I<HASH>, I<KEY_LIST>) |
3360
|
|
|
|
|
|
|
|
3361
|
|
|
|
|
|
|
B<WARNING>: This does not mean what you think it means. Don't use it. |
3362
|
|
|
|
|
|
|
|
3363
|
|
|
|
|
|
|
This function is misnamed; it is the deprecated, confusing, legacy version |
3364
|
|
|
|
|
|
|
of L</assert_min_keys>. It really means L</assert_hash_keys_required>, |
3365
|
|
|
|
|
|
|
which in turn means "has at B<most> these keys". It does not mean has these |
3366
|
|
|
|
|
|
|
exact keys and nothing else. |
3367
|
|
|
|
|
|
|
|
3368
|
|
|
|
|
|
|
For that, you want L</assert_keys>. |
3369
|
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
|
=item assert_hash_keys_required(I<HASH>, I<KEY_LIST>) |
3371
|
|
|
|
|
|
|
|
3372
|
|
|
|
|
|
|
=for comment |
3373
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3374
|
|
|
|
|
|
|
|
3375
|
|
|
|
|
|
|
Z<> |
3376
|
|
|
|
|
|
|
|
3377
|
|
|
|
|
|
|
assert_hash_keys_required(%hash, qw[name rank serno]); |
3378
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
This is the legacy version of L</assert_min_keys>. |
3380
|
|
|
|
|
|
|
Means "has at B<most> these keys". |
3381
|
|
|
|
|
|
|
|
3382
|
|
|
|
|
|
|
Each key specified in the key list must exist in the hash, |
3383
|
|
|
|
|
|
|
but it's ok if there are other non-required keys. |
3384
|
|
|
|
|
|
|
|
3385
|
|
|
|
|
|
|
If immediately after you validate the required keys from the I<KEY_LIST>, |
3386
|
|
|
|
|
|
|
you intend to validate the allowed keys using that same I<KEY_LIST> because |
3387
|
|
|
|
|
|
|
you're required to have all your allowed keys: |
3388
|
|
|
|
|
|
|
|
3389
|
|
|
|
|
|
|
my @keys = qw[name rank serno]; |
3390
|
|
|
|
|
|
|
assert_hash_keys_required(%hash, @keys); |
3391
|
|
|
|
|
|
|
assert_hash_keys_allowed (%hash, @keys); |
3392
|
|
|
|
|
|
|
|
3393
|
|
|
|
|
|
|
Then it would be faster to just call L</assert_keys> in the first place. |
3394
|
|
|
|
|
|
|
|
3395
|
|
|
|
|
|
|
my @keys = qw[name rank serno]; |
3396
|
|
|
|
|
|
|
assert_keys(%hash, @keys); |
3397
|
|
|
|
|
|
|
|
3398
|
|
|
|
|
|
|
However, if you plan to lock the hash when you're done validating it, then |
3399
|
|
|
|
|
|
|
you can let the key-locker do the "allowed" step implicitly: |
3400
|
|
|
|
|
|
|
|
3401
|
|
|
|
|
|
|
use Hash::Util qw(lock_keys); |
3402
|
|
|
|
|
|
|
my @required = qw[name rank serno]; |
3403
|
|
|
|
|
|
|
my @allowed = (@required, qw[spouse]); |
3404
|
|
|
|
|
|
|
assert_hash_keys_required(%hash, @required); |
3405
|
|
|
|
|
|
|
lock_keys(%hash, @allowed); |
3406
|
|
|
|
|
|
|
|
3407
|
|
|
|
|
|
|
=item assert_hash_keys_allowed(I<HASH>, I<KEY_LIST>) |
3408
|
|
|
|
|
|
|
|
3409
|
|
|
|
|
|
|
This is the legacy version of L</assert_max_keys>. |
3410
|
|
|
|
|
|
|
Means "has at B<least> these keys". |
3411
|
|
|
|
|
|
|
|
3412
|
|
|
|
|
|
|
Only keys in the non-empty I<KEY_LIST> are allowed in the I<HASH>, |
3413
|
|
|
|
|
|
|
bit if some of those aren't there yet, that's ok. |
3414
|
|
|
|
|
|
|
|
3415
|
|
|
|
|
|
|
For many applications of a hash, once you've validated that its keys are |
3416
|
|
|
|
|
|
|
all allowed, you would be well-advised to lock its keys afterwards so that |
3417
|
|
|
|
|
|
|
you know it can't ever get any stray keys added later that aren't in your |
3418
|
|
|
|
|
|
|
I<KEY_LIST>. For example: |
3419
|
|
|
|
|
|
|
|
3420
|
|
|
|
|
|
|
use Hash::Util qw(lock_keys); |
3421
|
|
|
|
|
|
|
my @possible_keys = qw[fee fie foe fum]; |
3422
|
|
|
|
|
|
|
assert_hash_keys_allowed(%some_hash, @possible_keys); |
3423
|
|
|
|
|
|
|
lock_keys(%some_hash, @possible_keys); |
3424
|
|
|
|
|
|
|
|
3425
|
|
|
|
|
|
|
If you're going to do that, you should skip the assertion and let the core |
3426
|
|
|
|
|
|
|
C code do all your checking for you, since it's much quicker that way. |
3427
|
|
|
|
|
|
|
|
3428
|
|
|
|
|
|
|
use Hash::Util qw(lock_keys); |
3429
|
|
|
|
|
|
|
my @possible_keys = qw[fee fie foe fum]; |
3430
|
|
|
|
|
|
|
lock_keys(%some_hash, @possible_keys); |
3431
|
|
|
|
|
|
|
|
3432
|
|
|
|
|
|
|
If the hash contains keys other than those listed, you'll still die |
3433
|
|
|
|
|
|
|
at that point. |
3434
|
|
|
|
|
|
|
|
3435
|
|
|
|
|
|
|
=item assert_hash_keys_required_and_allowed(I<HASH>, I<MIN_ARRAYREF>, I<MAX_ARRAYREF>) |
3436
|
|
|
|
|
|
|
|
3437
|
|
|
|
|
|
|
This is the legacy version of L</assert_minmax_keys>, but it does allow you |
3438
|
|
|
|
|
|
|
to pass the min and max arrayrefs as expressions rather than as named |
3439
|
|
|
|
|
|
|
variables. |
3440
|
|
|
|
|
|
|
|
3441
|
|
|
|
|
|
|
assert_hash_keys_required_and_allowed(%hash, [qw<fie fie foe>], [qw<fee foe foe fum]); |
3442
|
|
|
|
|
|
|
|
3443
|
|
|
|
|
|
|
This lets you specify the minimal required keys and the maximum allowed |
3444
|
|
|
|
|
|
|
keys in the same assertion. You must pass the required and allowed keys by |
3445
|
|
|
|
|
|
|
arrayref so that they don't run together. |
3446
|
|
|
|
|
|
|
|
3447
|
|
|
|
|
|
|
If you have them in arrays already, this is equivalent and is easier to |
3448
|
|
|
|
|
|
|
understand: |
3449
|
|
|
|
|
|
|
|
3450
|
|
|
|
|
|
|
@minkeys = qw(fee fie foe); |
3451
|
|
|
|
|
|
|
@maxkeys = (@minkeys, "fum"); |
3452
|
|
|
|
|
|
|
assert_minmax_keys(%hash, @minkeys, @maxkeys); |
3453
|
|
|
|
|
|
|
|
3454
|
|
|
|
|
|
|
=item assert_hash_keys_allowed_and_required(I<HASH>, I<MAX_ARRAYREF>, I<MIN_ARRAYREF>) |
3455
|
|
|
|
|
|
|
|
3456
|
|
|
|
|
|
|
=for comment |
3457
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3458
|
|
|
|
|
|
|
|
3459
|
|
|
|
|
|
|
Z<> |
3460
|
|
|
|
|
|
|
|
3461
|
|
|
|
|
|
|
assert_hash_keys_allowed_and_required(%hash, [qw<fee foe foe fum], [qw<fie fie foe>]); |
3462
|
|
|
|
|
|
|
|
3463
|
|
|
|
|
|
|
This one flips the arguments, putting the maximum allowed keys before the |
3464
|
|
|
|
|
|
|
minimum required keys. It does not required named variables as all three |
3465
|
|
|
|
|
|
|
arguments the way L</assert_minmax_keys> does. |
3466
|
|
|
|
|
|
|
|
3467
|
|
|
|
|
|
|
=item assert_hashref_keys(I<HASHREF>, I<KEY_LIST>) |
3468
|
|
|
|
|
|
|
|
3469
|
|
|
|
|
|
|
B<WARNING>: This does not mean what you think it means. Don't use it. |
3470
|
|
|
|
|
|
|
|
3471
|
|
|
|
|
|
|
This function is misnamed; it is the deprecated, confusing, legacy version |
3472
|
|
|
|
|
|
|
of L</assert_min_keys>. It really means L</assert_hashref_keys_required>, |
3473
|
|
|
|
|
|
|
which in turn means "has at B<most> these keys". It does not mean has these |
3474
|
|
|
|
|
|
|
exact keys and nothing else. |
3475
|
|
|
|
|
|
|
|
3476
|
|
|
|
|
|
|
For that, you want L</assert_keys>. |
3477
|
|
|
|
|
|
|
|
3478
|
|
|
|
|
|
|
=item assert_hashref_keys_required(I<HASHREF>, I<KEY_LIST>) |
3479
|
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
|
This is the legacy version of L</assert_min_keys>. |
3481
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
Means "has at B<least> these keys". |
3483
|
|
|
|
|
|
|
|
3484
|
|
|
|
|
|
|
Each key specified in the non-empty I<KEY_LIST> must exist in the |
3485
|
|
|
|
|
|
|
I<HASHREF>'s referent, but it's ok if there are other non-required keys. |
3486
|
|
|
|
|
|
|
|
3487
|
|
|
|
|
|
|
See also the equivalent L</assert_min_keys> which works on both hashes and |
3488
|
|
|
|
|
|
|
hashrefs. |
3489
|
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
=item assert_hashref_keys_allowed(I<HASHREF>, I<KEY_LIST>) |
3491
|
|
|
|
|
|
|
|
3492
|
|
|
|
|
|
|
This is the legacy version of L</assert_max_keys>. |
3493
|
|
|
|
|
|
|
|
3494
|
|
|
|
|
|
|
Means "has at B<most> these keys". |
3495
|
|
|
|
|
|
|
|
3496
|
|
|
|
|
|
|
Only keys in the non-empty I<KEY_LIST> are allowed in the hash by I<HASHREF>, |
3497
|
|
|
|
|
|
|
but no checks are done to make sure that those in particular are there yet. |
3498
|
|
|
|
|
|
|
|
3499
|
|
|
|
|
|
|
For many applications of a hashref, once you've validated that its keys are |
3500
|
|
|
|
|
|
|
all allowed, you would be well-advised to lock its keys afterwards to that |
3501
|
|
|
|
|
|
|
you know it can't get any strays added later that aren't in your |
3502
|
|
|
|
|
|
|
I<KEY_LIST>. For example: |
3503
|
|
|
|
|
|
|
|
3504
|
|
|
|
|
|
|
use Hash::Util qw(lock_ref_keys); |
3505
|
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
my @allowed_keys = qw[fee fie foe fum]; |
3507
|
|
|
|
|
|
|
|
3508
|
|
|
|
|
|
|
assert_hashref_keys_allowed($hashref, @allowed_keys); |
3509
|
|
|
|
|
|
|
lock_ref_keys($hashref, @allowed_keys); |
3510
|
|
|
|
|
|
|
|
3511
|
|
|
|
|
|
|
See also the equivalent L</assert_max_keys> which works on both hashes and hashrefs. |
3512
|
|
|
|
|
|
|
|
3513
|
|
|
|
|
|
|
=item assert_hashref_keys_required_and_allowed(I<HASH>, I<MIN_ARRAYREF>, I<MAX_ARRAYREF>) |
3514
|
|
|
|
|
|
|
|
3515
|
|
|
|
|
|
|
=for comment |
3516
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3517
|
|
|
|
|
|
|
|
3518
|
|
|
|
|
|
|
Z<> |
3519
|
|
|
|
|
|
|
|
3520
|
|
|
|
|
|
|
assert_hashref_keys_required_and_allowed(%hash, [qw<fie fie foe>], [qw<fee foe foe fum]); |
3521
|
|
|
|
|
|
|
|
3522
|
|
|
|
|
|
|
This is the reference version of L</assert_hash_keys_required_and_allowed>. |
3523
|
|
|
|
|
|
|
|
3524
|
|
|
|
|
|
|
See also L</assert_minmax_keys>, which allowed both hashes and hashrefs as |
3525
|
|
|
|
|
|
|
the first argument, but requires either arrays or scalar variables holding |
3526
|
|
|
|
|
|
|
arrayrefs in the other two arguments. |
3527
|
|
|
|
|
|
|
|
3528
|
|
|
|
|
|
|
=item assert_hashref_keys_allowed_and_required(I<HASH>, I<MAX_ARRAYREF>, I<MIN_ARRAYREF>) |
3529
|
|
|
|
|
|
|
|
3530
|
|
|
|
|
|
|
=for comment |
3531
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3532
|
|
|
|
|
|
|
|
3533
|
|
|
|
|
|
|
Z<> |
3534
|
|
|
|
|
|
|
|
3535
|
|
|
|
|
|
|
assert_hash_keys_allowed_and_required(%hash, [qw<fee foe foe fum], [qw<fie fie foe>]); |
3536
|
|
|
|
|
|
|
|
3537
|
|
|
|
|
|
|
This is the legacy version of L</assert_minmax_keys>, but it does allow you |
3538
|
|
|
|
|
|
|
to pass the min and max arrayrefs as expressions rather than as named |
3539
|
|
|
|
|
|
|
variables. The L<assert_minmax_keys> assertion requires either array |
3540
|
|
|
|
|
|
|
variables or scalar variables holding arrayrefs in the other two arguments. |
3541
|
|
|
|
|
|
|
|
3542
|
|
|
|
|
|
|
This is the reference version of L</assert_hash_keys_allowed_and_required>. |
3543
|
|
|
|
|
|
|
|
3544
|
|
|
|
|
|
|
=back |
3545
|
|
|
|
|
|
|
|
3546
|
|
|
|
|
|
|
=head2 Assertions about References |
3547
|
|
|
|
|
|
|
|
3548
|
|
|
|
|
|
|
=over |
3549
|
|
|
|
|
|
|
|
3550
|
|
|
|
|
|
|
=item assert_anyref(I<ARG>) |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
Argument must be a reference. |
3553
|
|
|
|
|
|
|
|
3554
|
|
|
|
|
|
|
=item assert_nonref(I<ARG>) |
3555
|
|
|
|
|
|
|
|
3556
|
|
|
|
|
|
|
Argument must not be a reference. |
3557
|
|
|
|
|
|
|
|
3558
|
|
|
|
|
|
|
=item assert_reftype(I<TYPE>, I<REF>) |
3559
|
|
|
|
|
|
|
|
3560
|
|
|
|
|
|
|
The basic type of the reference must match the one specified. |
3561
|
|
|
|
|
|
|
|
3562
|
|
|
|
|
|
|
=item assert_globref(I<ARG>) |
3563
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
Argument must be a GLOB ref. |
3565
|
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
|
=item assert_ioref(I<ARG>) |
3567
|
|
|
|
|
|
|
|
3568
|
|
|
|
|
|
|
Argument must be a IO ref. You probably don't |
3569
|
|
|
|
|
|
|
want this; you probably want L</assert_open_handle>. |
3570
|
|
|
|
|
|
|
|
3571
|
|
|
|
|
|
|
=item assert_coderef(I<ARG>) |
3572
|
|
|
|
|
|
|
|
3573
|
|
|
|
|
|
|
Argument must be a CODE ref. |
3574
|
|
|
|
|
|
|
|
3575
|
|
|
|
|
|
|
=item assert_hashref(I<ARG>) |
3576
|
|
|
|
|
|
|
|
3577
|
|
|
|
|
|
|
Argument must be a HASH ref. |
3578
|
|
|
|
|
|
|
|
3579
|
|
|
|
|
|
|
=item assert_arrayref(I<ARG>) |
3580
|
|
|
|
|
|
|
|
3581
|
|
|
|
|
|
|
Argument must be an ARRAY ref. |
3582
|
|
|
|
|
|
|
|
3583
|
|
|
|
|
|
|
=item assert_scalarref(I<ARG>) |
3584
|
|
|
|
|
|
|
|
3585
|
|
|
|
|
|
|
Argument must be a SCALAR ref. |
3586
|
|
|
|
|
|
|
|
3587
|
|
|
|
|
|
|
=item assert_refref(I<ARG>) |
3588
|
|
|
|
|
|
|
|
3589
|
|
|
|
|
|
|
Argument must be a REF ref. |
3590
|
|
|
|
|
|
|
|
3591
|
|
|
|
|
|
|
=item assert_unblessed_ref(I<ARG>) |
3592
|
|
|
|
|
|
|
|
3593
|
|
|
|
|
|
|
Scalar argument must be a ref of any sort but not a blessed one. |
3594
|
|
|
|
|
|
|
|
3595
|
|
|
|
|
|
|
=back |
3596
|
|
|
|
|
|
|
|
3597
|
|
|
|
|
|
|
=head2 Assertions about Objects |
3598
|
|
|
|
|
|
|
|
3599
|
|
|
|
|
|
|
=over |
3600
|
|
|
|
|
|
|
|
3601
|
|
|
|
|
|
|
=item assert_method() |
3602
|
|
|
|
|
|
|
|
3603
|
|
|
|
|
|
|
Function must have at least one argument. |
3604
|
|
|
|
|
|
|
|
3605
|
|
|
|
|
|
|
=item assert_object_method() |
3606
|
|
|
|
|
|
|
|
3607
|
|
|
|
|
|
|
First argument to function must be blessed. |
3608
|
|
|
|
|
|
|
|
3609
|
|
|
|
|
|
|
=item assert_class_method() |
3610
|
|
|
|
|
|
|
|
3611
|
|
|
|
|
|
|
First argument to function must not be blessed. |
3612
|
|
|
|
|
|
|
|
3613
|
|
|
|
|
|
|
=item assert_public_method() |
3614
|
|
|
|
|
|
|
|
3615
|
|
|
|
|
|
|
Just like L</assert_method>. In other words, it makes sure that there's an |
3616
|
|
|
|
|
|
|
invocant, but beyond that does nothing other than add a bit of declarative |
3617
|
|
|
|
|
|
|
syntax to help document your intent. |
3618
|
|
|
|
|
|
|
|
3619
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3620
|
|
|
|
|
|
|
|
3621
|
|
|
|
|
|
|
=item assert_private_method() |
3622
|
|
|
|
|
|
|
|
3623
|
|
|
|
|
|
|
Must have been called by a sub compiled from the same file and package. |
3624
|
|
|
|
|
|
|
|
3625
|
|
|
|
|
|
|
Now, you would think this would be a trivial check, and it should be, but |
3626
|
|
|
|
|
|
|
the fluid-programming folks have decided they love to wrap and rewrap and |
3627
|
|
|
|
|
|
|
unwrap and rerewrap functions so that their stacks are a lie. There are |
3628
|
|
|
|
|
|
|
uncountably many ways to "wrap" subroutines in perl, all of which introduce |
3629
|
|
|
|
|
|
|
extra frames that "shouldn't" be there and which cause this assertion to |
3630
|
|
|
|
|
|
|
suddenly fail. As a sop to one of the more common ways, frames whose |
3631
|
|
|
|
|
|
|
calling package is L<Class::MOP::Method::Wrapped> are deliberately exempt |
3632
|
|
|
|
|
|
|
from this check, and are skipped over. |
3633
|
|
|
|
|
|
|
|
3634
|
|
|
|
|
|
|
Moose roles do not have access to private methods, only to protected ones. |
3635
|
|
|
|
|
|
|
See next. |
3636
|
|
|
|
|
|
|
|
3637
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3638
|
|
|
|
|
|
|
|
3639
|
|
|
|
|
|
|
=item assert_protected_method() |
3640
|
|
|
|
|
|
|
|
3641
|
|
|
|
|
|
|
The current sub must have been called by this package or from |
3642
|
|
|
|
|
|
|
that of one its subclasses. |
3643
|
|
|
|
|
|
|
|
3644
|
|
|
|
|
|
|
Or... |
3645
|
|
|
|
|
|
|
|
3646
|
|
|
|
|
|
|
Or... |
3647
|
|
|
|
|
|
|
|
3648
|
|
|
|
|
|
|
Or... |
3649
|
|
|
|
|
|
|
|
3650
|
|
|
|
|
|
|
Or something about Moose roles, whatever those are. If you use them, then |
3651
|
|
|
|
|
|
|
use this assertion at your own risk, but it I<seems> to work. |
3652
|
|
|
|
|
|
|
|
3653
|
|
|
|
|
|
|
Maybe. |
3654
|
|
|
|
|
|
|
|
3655
|
|
|
|
|
|
|
The protection racket is a terrible business model. Strongly consider |
3656
|
|
|
|
|
|
|
forbidding all access. A simpler life is a better life. |
3657
|
|
|
|
|
|
|
|
3658
|
|
|
|
|
|
|
See also L<MooseX::Privacy>. |
3659
|
|
|
|
|
|
|
|
3660
|
|
|
|
|
|
|
Does not work under L<Test::Exception>. |
3661
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
=item assert_known_package(I<ARG>) |
3663
|
|
|
|
|
|
|
|
3664
|
|
|
|
|
|
|
The specified argument's package symbol table |
3665
|
|
|
|
|
|
|
is not empty. |
3666
|
|
|
|
|
|
|
|
3667
|
|
|
|
|
|
|
=item assert_object(I<ARG>) |
3668
|
|
|
|
|
|
|
|
3669
|
|
|
|
|
|
|
Argument must be an object. |
3670
|
|
|
|
|
|
|
|
3671
|
|
|
|
|
|
|
=item assert_nonobject(I<ARG>) |
3672
|
|
|
|
|
|
|
|
3673
|
|
|
|
|
|
|
Argument must not be an object. |
3674
|
|
|
|
|
|
|
|
3675
|
|
|
|
|
|
|
=item assert_can(I<INVOCANT>, I<METHOD_LIST>) |
3676
|
|
|
|
|
|
|
|
3677
|
|
|
|
|
|
|
The invocant, which can be a package name or an object but not an unblessed |
3678
|
|
|
|
|
|
|
reference, can invoke all the methods listed. |
3679
|
|
|
|
|
|
|
|
3680
|
|
|
|
|
|
|
=item assert_cant(I<INVOCANT>, I<METHOD_LIST>) |
3681
|
|
|
|
|
|
|
|
3682
|
|
|
|
|
|
|
The invocant, which can be a package name or an object but not an unblessed |
3683
|
|
|
|
|
|
|
reference, cannot invoke any of the methods listed. |
3684
|
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
|
=item assert_object_can(I<OBJECT>, I<METHOD_LIST>) |
3686
|
|
|
|
|
|
|
|
3687
|
|
|
|
|
|
|
The object can invoke all of the methods listed. |
3688
|
|
|
|
|
|
|
|
3689
|
|
|
|
|
|
|
=item assert_object_cant(I<OBJECT>, I<METHOD_LIST>) |
3690
|
|
|
|
|
|
|
|
3691
|
|
|
|
|
|
|
The object cannot invoke any of the methods listed. |
3692
|
|
|
|
|
|
|
|
3693
|
|
|
|
|
|
|
=item assert_class_can(I<CLASS>, I<METHOD_LIST>) |
3694
|
|
|
|
|
|
|
|
3695
|
|
|
|
|
|
|
The known class can invoke all the methods listed. |
3696
|
|
|
|
|
|
|
|
3697
|
|
|
|
|
|
|
=item assert_class_cant(I<CLASS>, I<METHOD_LIST>) |
3698
|
|
|
|
|
|
|
|
3699
|
|
|
|
|
|
|
The known class cannot invoke any of the methods listed. |
3700
|
|
|
|
|
|
|
|
3701
|
|
|
|
|
|
|
=item assert_isa(I<INVOCANT>, I<CLASS_LIST>) |
3702
|
|
|
|
|
|
|
|
3703
|
|
|
|
|
|
|
The invocant, which can be a package name or an object but not an unblessed |
3704
|
|
|
|
|
|
|
reference, must be a subclass of each class listed. |
3705
|
|
|
|
|
|
|
|
3706
|
|
|
|
|
|
|
=item assert_ainta(I<INVOCANT>, I<CLASS_LIST>) |
3707
|
|
|
|
|
|
|
|
3708
|
|
|
|
|
|
|
The invocant cannot be a subclass of any class listed. |
3709
|
|
|
|
|
|
|
|
3710
|
|
|
|
|
|
|
=item assert_object_isa(I<OBJECT>, I<CLASS_LIST>) |
3711
|
|
|
|
|
|
|
|
3712
|
|
|
|
|
|
|
The object must be a subclass of each class listed. |
3713
|
|
|
|
|
|
|
|
3714
|
|
|
|
|
|
|
=item assert_object_ainta |
3715
|
|
|
|
|
|
|
|
3716
|
|
|
|
|
|
|
The object cannot be a subclass of any class listed. |
3717
|
|
|
|
|
|
|
|
3718
|
|
|
|
|
|
|
=item assert_class_isa(I<CLASS>, I<CLASS_LIST>) |
3719
|
|
|
|
|
|
|
|
3720
|
|
|
|
|
|
|
The known class must be a subclass of each class listed. |
3721
|
|
|
|
|
|
|
|
3722
|
|
|
|
|
|
|
=item assert_class_ainta(I<CLASS>, I<CLASS_LIST>) |
3723
|
|
|
|
|
|
|
|
3724
|
|
|
|
|
|
|
The known class cannot be a subclass of any class listed. |
3725
|
|
|
|
|
|
|
|
3726
|
|
|
|
|
|
|
=item assert_does(I<INVOCANT>, I<CLASS_LIST>) |
3727
|
|
|
|
|
|
|
|
3728
|
|
|
|
|
|
|
The invocant must C<< ->DOES >> each class in the class list. |
3729
|
|
|
|
|
|
|
|
3730
|
|
|
|
|
|
|
=item assert_doesnt(I<INVOCANT>, I<CLASS_LIST>) |
3731
|
|
|
|
|
|
|
|
3732
|
|
|
|
|
|
|
The invocant must not C<< ->DOES >> any class in the class list. |
3733
|
|
|
|
|
|
|
|
3734
|
|
|
|
|
|
|
=item assert_object_overloads(I<OBJECT> [, I<OP_LIST> ]) |
3735
|
|
|
|
|
|
|
|
3736
|
|
|
|
|
|
|
=for comment |
3737
|
|
|
|
|
|
|
This is a workaround to create a "blank" line so that the code sample is distinct. |
3738
|
|
|
|
|
|
|
|
3739
|
|
|
|
|
|
|
Z<> |
3740
|
|
|
|
|
|
|
|
3741
|
|
|
|
|
|
|
assert_object_overloads($some_object); |
3742
|
|
|
|
|
|
|
|
3743
|
|
|
|
|
|
|
assert_object_overloads($some_object, qw(+ += ++)); |
3744
|
|
|
|
|
|
|
|
3745
|
|
|
|
|
|
|
The I<OBJECT> argument must have overloaded operators. |
3746
|
|
|
|
|
|
|
|
3747
|
|
|
|
|
|
|
If any operators are given in the I<OP_LIST>, then each of these |
3748
|
|
|
|
|
|
|
must also have an overload method. |
3749
|
|
|
|
|
|
|
|
3750
|
|
|
|
|
|
|
See L<overload>. |
3751
|
|
|
|
|
|
|
|
3752
|
|
|
|
|
|
|
=item assert_object_stringifies(I<OBJECT>) |
3753
|
|
|
|
|
|
|
|
3754
|
|
|
|
|
|
|
The I<OBJECT> argument must have an overloaded stringification operator. |
3755
|
|
|
|
|
|
|
|
3756
|
|
|
|
|
|
|
=item assert_object_nummifies(I<OBJECT>) |
3757
|
|
|
|
|
|
|
|
3758
|
|
|
|
|
|
|
The I<OBJECT> argument must have an overloaded nummification operator. |
3759
|
|
|
|
|
|
|
|
3760
|
|
|
|
|
|
|
(And yes, I meant to spell it this way: I<nummify> rhymes with I<mummify> and |
3761
|
|
|
|
|
|
|
I<dummify>, not with I<humify> and I<fumify>. We aren't talking about |
3762
|
|
|
|
|
|
|
making an object I<numinous>, which is something else entirely.) |
3763
|
|
|
|
|
|
|
|
3764
|
|
|
|
|
|
|
=item assert_object_boolifies(I<OBJECT>) |
3765
|
|
|
|
|
|
|
|
3766
|
|
|
|
|
|
|
The I<OBJECT> argument must have an overloaded boolification operator. |
3767
|
|
|
|
|
|
|
|
3768
|
|
|
|
|
|
|
=item assert_tied(I<VARIABLE)>) |
3769
|
|
|
|
|
|
|
|
3770
|
|
|
|
|
|
|
The I<VARIABLE> argument must be a tied C<$scalar>, |
3771
|
|
|
|
|
|
|
C<@array>, C<%hash>, or C<*glob>. |
3772
|
|
|
|
|
|
|
|
3773
|
|
|
|
|
|
|
=item assert_untied(I<VARIABLE>) |
3774
|
|
|
|
|
|
|
|
3775
|
|
|
|
|
|
|
The I<VARIABLE> argument must not be a tied C<$scalar>, |
3776
|
|
|
|
|
|
|
C<@array>, C<%hash>, or C<*glob>. |
3777
|
|
|
|
|
|
|
|
3778
|
|
|
|
|
|
|
=item assert_tied_referent(I<REF>) |
3779
|
|
|
|
|
|
|
|
3780
|
|
|
|
|
|
|
The I<REF> argument must be a reference to a tied C<$scalar>, |
3781
|
|
|
|
|
|
|
C<@array>, C<%hash>, or C<*glob>. |
3782
|
|
|
|
|
|
|
|
3783
|
|
|
|
|
|
|
Consider that have this arrangement: |
3784
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
tie my %hash, "DB_File", "/some/path"; |
3786
|
|
|
|
|
|
|
my $hashref = \%hash; |
3787
|
|
|
|
|
|
|
|
3788
|
|
|
|
|
|
|
You could use |
3789
|
|
|
|
|
|
|
|
3790
|
|
|
|
|
|
|
assert_tied(%hash); |
3791
|
|
|
|
|
|
|
|
3792
|
|
|
|
|
|
|
or you could use |
3793
|
|
|
|
|
|
|
|
3794
|
|
|
|
|
|
|
assert_tied_referent($hashref); |
3795
|
|
|
|
|
|
|
|
3796
|
|
|
|
|
|
|
But you could not use |
3797
|
|
|
|
|
|
|
|
3798
|
|
|
|
|
|
|
assert_tied($hashref); |
3799
|
|
|
|
|
|
|
|
3800
|
|
|
|
|
|
|
Because that would ask whether C<$hashref> itself has been tied, |
3801
|
|
|
|
|
|
|
not whether the thing it's referring to has been. For that, you |
3802
|
|
|
|
|
|
|
would use |
3803
|
|
|
|
|
|
|
|
3804
|
|
|
|
|
|
|
assert_tied_hashref($hashref); |
3805
|
|
|
|
|
|
|
|
3806
|
|
|
|
|
|
|
=item assert_untied_referent(I<REF>) |
3807
|
|
|
|
|
|
|
|
3808
|
|
|
|
|
|
|
The I<REF> argument must not be a reference to a tied C<$scalar>, |
3809
|
|
|
|
|
|
|
C<@array>, C<%hash>, or C<*glob>. |
3810
|
|
|
|
|
|
|
|
3811
|
|
|
|
|
|
|
=item assert_tied_scalar(I<SCALAR>) |
3812
|
|
|
|
|
|
|
|
3813
|
|
|
|
|
|
|
The I<SCALAR> argument must be tied to a class. |
3814
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
=item assert_untied_scalar(I<SCALAR>) |
3816
|
|
|
|
|
|
|
|
3817
|
|
|
|
|
|
|
The I<SCALAR> argument must not be tied to a class. |
3818
|
|
|
|
|
|
|
|
3819
|
|
|
|
|
|
|
=item assert_tied_scalarref(I<SCALARREF>) |
3820
|
|
|
|
|
|
|
|
3821
|
|
|
|
|
|
|
The scalar referenced by I<SCALARREf> must be tied to a class. |
3822
|
|
|
|
|
|
|
|
3823
|
|
|
|
|
|
|
=item assert_untied_scalarref(I<SCALARREF>) |
3824
|
|
|
|
|
|
|
|
3825
|
|
|
|
|
|
|
The scalar referenced by I<SCALARREf> must not be tied to a class. |
3826
|
|
|
|
|
|
|
|
3827
|
|
|
|
|
|
|
=item assert_tied_array(I<ARRAY>) |
3828
|
|
|
|
|
|
|
|
3829
|
|
|
|
|
|
|
The I<ARRAY> argument must be tied to a class. |
3830
|
|
|
|
|
|
|
|
3831
|
|
|
|
|
|
|
=item assert_untied_array(I<ARRAY>) |
3832
|
|
|
|
|
|
|
|
3833
|
|
|
|
|
|
|
The I<ARRAY> argument must not be tied to a class. |
3834
|
|
|
|
|
|
|
|
3835
|
|
|
|
|
|
|
=item assert_tied_arrayref(I<ARRAYREF>) |
3836
|
|
|
|
|
|
|
|
3837
|
|
|
|
|
|
|
The array referenced by I<ARRAYREf> must be tied to a class. |
3838
|
|
|
|
|
|
|
|
3839
|
|
|
|
|
|
|
=item assert_untied_arrayref(I<ARRAYREF>) |
3840
|
|
|
|
|
|
|
|
3841
|
|
|
|
|
|
|
The array referenced by I<ARRAYREf> must not be tied to a class. |
3842
|
|
|
|
|
|
|
|
3843
|
|
|
|
|
|
|
=item assert_tied_hash(I<HASH>) |
3844
|
|
|
|
|
|
|
|
3845
|
|
|
|
|
|
|
The I<HASH> argument must be tied to a class. |
3846
|
|
|
|
|
|
|
|
3847
|
|
|
|
|
|
|
=item assert_untied_hash(I<HASH>) |
3848
|
|
|
|
|
|
|
|
3849
|
|
|
|
|
|
|
The I<HASH> argument must not be tied to a class. |
3850
|
|
|
|
|
|
|
|
3851
|
|
|
|
|
|
|
=item assert_tied_hashref(I<HASHREF>) |
3852
|
|
|
|
|
|
|
|
3853
|
|
|
|
|
|
|
The hash referenced by I<HASHREf> must be tied to a class. |
3854
|
|
|
|
|
|
|
|
3855
|
|
|
|
|
|
|
=item assert_untied_hashref(I<HASHREF>) |
3856
|
|
|
|
|
|
|
|
3857
|
|
|
|
|
|
|
The hash referenced by I<HASHREf> must not be tied to a class. |
3858
|
|
|
|
|
|
|
|
3859
|
|
|
|
|
|
|
=item assert_tied_glob(I<GLOB>) |
3860
|
|
|
|
|
|
|
|
3861
|
|
|
|
|
|
|
The I<GLOB> argument must be tied to a class. |
3862
|
|
|
|
|
|
|
|
3863
|
|
|
|
|
|
|
=item assert_untied_glob(I<GLOB>) |
3864
|
|
|
|
|
|
|
|
3865
|
|
|
|
|
|
|
The I<GLOB> argument must not be tied to a class. |
3866
|
|
|
|
|
|
|
|
3867
|
|
|
|
|
|
|
=item assert_tied_globref(I<GLOBREF>) |
3868
|
|
|
|
|
|
|
|
3869
|
|
|
|
|
|
|
The typeglob referenced by I<GLOBREf> must be tied to a class. |
3870
|
|
|
|
|
|
|
|
3871
|
|
|
|
|
|
|
=item assert_untied_globref(I<GLOBREF>) |
3872
|
|
|
|
|
|
|
|
3873
|
|
|
|
|
|
|
The typeglob referenced by I<GLOBREf> must not be tied to a class. |
3874
|
|
|
|
|
|
|
|
3875
|
|
|
|
|
|
|
=back |
3876
|
|
|
|
|
|
|
|
3877
|
|
|
|
|
|
|
=head2 Assertions about Code |
3878
|
|
|
|
|
|
|
|
3879
|
|
|
|
|
|
|
=over |
3880
|
|
|
|
|
|
|
|
3881
|
|
|
|
|
|
|
=item assert_happy_code(I<CODE_BLOCK>) |
3882
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
The supplied code block returns true. |
3884
|
|
|
|
|
|
|
|
3885
|
|
|
|
|
|
|
This one and the next give nice error messages, but are not |
3886
|
|
|
|
|
|
|
wholly removed from your program's parse tree at compile time |
3887
|
|
|
|
|
|
|
is assertions are off: the argument is not called, but an empty |
3888
|
|
|
|
|
|
|
function is. |
3889
|
|
|
|
|
|
|
|
3890
|
|
|
|
|
|
|
For example, if you want to assert that you have more than 10 elements |
3891
|
|
|
|
|
|
|
in your @colors array, you would write: |
3892
|
|
|
|
|
|
|
|
3893
|
|
|
|
|
|
|
assert_happy_code { @colors > 10 }; |
3894
|
|
|
|
|
|
|
|
3895
|
|
|
|
|
|
|
If the return value of that code block is false, then you'll see something like this: |
3896
|
|
|
|
|
|
|
|
3897
|
|
|
|
|
|
|
happy-test[96620]: botched assertion assert_happy_code: Happy test { @colors > 10 } is sadly false, bailing out at happy-test[96620] line 38. |
3898
|
|
|
|
|
|
|
|
3899
|
|
|
|
|
|
|
When there is more than one statement, then the block is presented with newlines. For example: |
3900
|
|
|
|
|
|
|
|
3901
|
|
|
|
|
|
|
assert_happy_code { |
3902
|
|
|
|
|
|
|
if (@colors < 10) { |
3903
|
|
|
|
|
|
|
@allowed > 5; |
3904
|
|
|
|
|
|
|
} else { |
3905
|
|
|
|
|
|
|
@required > 5; |
3906
|
|
|
|
|
|
|
} |
3907
|
|
|
|
|
|
|
}; |
3908
|
|
|
|
|
|
|
|
3909
|
|
|
|
|
|
|
would indicate its failure this way: |
3910
|
|
|
|
|
|
|
|
3911
|
|
|
|
|
|
|
happy-test[96620]: botched assertion assert_happy_code: Happy test { |
3912
|
|
|
|
|
|
|
if (@colors < 10) { |
3913
|
|
|
|
|
|
|
@allowed > 5; |
3914
|
|
|
|
|
|
|
} else { |
3915
|
|
|
|
|
|
|
@required > 5; |
3916
|
|
|
|
|
|
|
} |
3917
|
|
|
|
|
|
|
} is sadly false, bailing out at happy-test line 38. |
3918
|
|
|
|
|
|
|
|
3919
|
|
|
|
|
|
|
Notice how you can't tell which bit failed there, so it's best to use |
3920
|
|
|
|
|
|
|
simple "boolean" expressions. |
3921
|
|
|
|
|
|
|
|
3922
|
|
|
|
|
|
|
=item assert_unhappy_code(I<CODE_BLOCK>) |
3923
|
|
|
|
|
|
|
|
3924
|
|
|
|
|
|
|
The supplied code block returns false. For example: |
3925
|
|
|
|
|
|
|
|
3926
|
|
|
|
|
|
|
assert_unhappy_code { @colors < 100 }; |
3927
|
|
|
|
|
|
|
|
3928
|
|
|
|
|
|
|
would say something like this if the assert fails: |
3929
|
|
|
|
|
|
|
|
3930
|
|
|
|
|
|
|
unhappy-test[96692]: botched assertion assert_unhappy_code: Unhappy assertion { @colors < 100 } is sadly true, bailing out at unhappy-test line 42. |
3931
|
|
|
|
|
|
|
|
3932
|
|
|
|
|
|
|
=back |
3933
|
|
|
|
|
|
|
|
3934
|
|
|
|
|
|
|
=head2 Assertions about Files |
3935
|
|
|
|
|
|
|
|
3936
|
|
|
|
|
|
|
=over |
3937
|
|
|
|
|
|
|
|
3938
|
|
|
|
|
|
|
=item assert_open_handle(I<ARG>) |
3939
|
|
|
|
|
|
|
|
3940
|
|
|
|
|
|
|
The argument represents an open filehandle. |
3941
|
|
|
|
|
|
|
|
3942
|
|
|
|
|
|
|
=item assert_regular_file(I<ARG>) |
3943
|
|
|
|
|
|
|
|
3944
|
|
|
|
|
|
|
The argument is a regular file. |
3945
|
|
|
|
|
|
|
|
3946
|
|
|
|
|
|
|
=item assert_text_file(I<ARG>) |
3947
|
|
|
|
|
|
|
|
3948
|
|
|
|
|
|
|
The argument is a regular file and a text file. |
3949
|
|
|
|
|
|
|
|
3950
|
|
|
|
|
|
|
=item assert_directory(I<ARG>) |
3951
|
|
|
|
|
|
|
|
3952
|
|
|
|
|
|
|
The argument is a directory. |
3953
|
|
|
|
|
|
|
|
3954
|
|
|
|
|
|
|
=back |
3955
|
|
|
|
|
|
|
|
3956
|
|
|
|
|
|
|
=head2 Assertions about Processes |
3957
|
|
|
|
|
|
|
|
3958
|
|
|
|
|
|
|
All these assertions take an optional status argument |
3959
|
|
|
|
|
|
|
as would be found in the C<$?> variable. If not status |
3960
|
|
|
|
|
|
|
argument is passed, the C<$?> is used by default. |
3961
|
|
|
|
|
|
|
|
3962
|
|
|
|
|
|
|
=over |
3963
|
|
|
|
|
|
|
|
3964
|
|
|
|
|
|
|
=item assert_legal_exit_status( [ I<STATUS> ]) |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
The numeric value fits in 16 bits. |
3967
|
|
|
|
|
|
|
|
3968
|
|
|
|
|
|
|
=item assert_signalled( [ I<STATUS> ]) |
3969
|
|
|
|
|
|
|
|
3970
|
|
|
|
|
|
|
The process was signalled. |
3971
|
|
|
|
|
|
|
|
3972
|
|
|
|
|
|
|
=item assert_unsignalled( [ I<STATUS> ]) |
3973
|
|
|
|
|
|
|
|
3974
|
|
|
|
|
|
|
The process was not signalled. |
3975
|
|
|
|
|
|
|
|
3976
|
|
|
|
|
|
|
=item assert_dumped_core( [ I<STATUS> ]) |
3977
|
|
|
|
|
|
|
|
3978
|
|
|
|
|
|
|
The process dumped core. |
3979
|
|
|
|
|
|
|
|
3980
|
|
|
|
|
|
|
=item assert_no_coredump( [ I<STATUS> ]) |
3981
|
|
|
|
|
|
|
|
3982
|
|
|
|
|
|
|
The process did not dump core. |
3983
|
|
|
|
|
|
|
|
3984
|
|
|
|
|
|
|
=item assert_exited( [ I<STATUS> ]) |
3985
|
|
|
|
|
|
|
|
3986
|
|
|
|
|
|
|
The process was not signalled, but rather exited |
3987
|
|
|
|
|
|
|
either explicitly or implicitly. |
3988
|
|
|
|
|
|
|
|
3989
|
|
|
|
|
|
|
=item assert_happy_exit( [ I<STATUS> ]) |
3990
|
|
|
|
|
|
|
|
3991
|
|
|
|
|
|
|
The process was not signalled and exited with an exit status of zero. |
3992
|
|
|
|
|
|
|
|
3993
|
|
|
|
|
|
|
=item assert_sad_exit( [ I<STATUS> ]) |
3994
|
|
|
|
|
|
|
|
3995
|
|
|
|
|
|
|
The process was not signalled but exited with a non-zero exit status. |
3996
|
|
|
|
|
|
|
|
3997
|
|
|
|
|
|
|
=back |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
=head1 EXAMPLES |
4000
|
|
|
|
|
|
|
|
4001
|
|
|
|
|
|
|
Suppose your team has decided that assertions should be governed by an |
4002
|
|
|
|
|
|
|
environment variable called C<RUNTIME_MODE>. You want assertions enabled |
4003
|
|
|
|
|
|
|
unless that variable is set to the string "production", or if there is an |
4004
|
|
|
|
|
|
|
C<NDEBUG> variable set. And you want all the assertions except for those |
4005
|
|
|
|
|
|
|
related to files or processes; that is, you don't want those two classes |
4006
|
|
|
|
|
|
|
of assertions to be fatal in non-production, but the others you do. |
4007
|
|
|
|
|
|
|
|
4008
|
|
|
|
|
|
|
You could call the module this way: |
4009
|
|
|
|
|
|
|
|
4010
|
|
|
|
|
|
|
use Env qw(RUNTIME_MODE NDEBUG); |
4011
|
|
|
|
|
|
|
|
4012
|
|
|
|
|
|
|
use Assert::Conditional ":all", |
4013
|
|
|
|
|
|
|
-unless => ($RUNTIME_MODE eq "production" || $DEBUG); |
4014
|
|
|
|
|
|
|
|
4015
|
|
|
|
|
|
|
use Assert::Conditional qw(:file :process"), -if => 0; |
4016
|
|
|
|
|
|
|
|
4017
|
|
|
|
|
|
|
On the other hand, you don't want everybody to have to |
4018
|
|
|
|
|
|
|
remember to type that in exactly the same way in every |
4019
|
|
|
|
|
|
|
module that uses it. So you want to create a simpler |
4020
|
|
|
|
|
|
|
interface where the whole team just says |
4021
|
|
|
|
|
|
|
|
4022
|
|
|
|
|
|
|
use MyAsserts; |
4023
|
|
|
|
|
|
|
|
4024
|
|
|
|
|
|
|
and it does the rest. Here's one way to do that: |
4025
|
|
|
|
|
|
|
|
4026
|
|
|
|
|
|
|
package MyAsserts; |
4027
|
|
|
|
|
|
|
|
4028
|
|
|
|
|
|
|
use v5.10; |
4029
|
|
|
|
|
|
|
use strict; |
4030
|
|
|
|
|
|
|
use warnings; |
4031
|
|
|
|
|
|
|
|
4032
|
|
|
|
|
|
|
use Env qw(RUNTIME_MODE NDEBUG); |
4033
|
|
|
|
|
|
|
|
4034
|
|
|
|
|
|
|
use Assert::Conditional ":all", |
4035
|
|
|
|
|
|
|
-unless => ($RUNTIME_MODE eq "production" || $NDEBUG); |
4036
|
|
|
|
|
|
|
|
4037
|
|
|
|
|
|
|
use Assert::Conditional qw(:file :process), |
4038
|
|
|
|
|
|
|
-if => 0; |
4039
|
|
|
|
|
|
|
|
4040
|
|
|
|
|
|
|
our @ISA = 'Exporter'; |
4041
|
|
|
|
|
|
|
our @EXPORT = @Assert::Conditional::EXPORT_OK; |
4042
|
|
|
|
|
|
|
our %EXPORT_TAGS = %Assert::Conditional::EXPORT_TAGS; |
4043
|
|
|
|
|
|
|
|
4044
|
|
|
|
|
|
|
Notice the module you wrote is just a regular exporter, not a fancier |
4045
|
|
|
|
|
|
|
conditional one. You've hidden the conditional part inside your module so |
4046
|
|
|
|
|
|
|
that everyone using it will get the same rules. |
4047
|
|
|
|
|
|
|
|
4048
|
|
|
|
|
|
|
Imagine a program that enables all assertions except those related to |
4049
|
|
|
|
|
|
|
argument counts, and then runs through a bunch of them before hitting a |
4050
|
|
|
|
|
|
|
failed assertion, at which point you get a stack dump about the failure: |
4051
|
|
|
|
|
|
|
|
4052
|
|
|
|
|
|
|
$ perl -Ilib tests/test-assert |
4053
|
|
|
|
|
|
|
check function called with 1 2 3 |
4054
|
|
|
|
|
|
|
test-assert[19009]: botched assertion assert_happy_code: Happy test { $i > $j } is sadly false, bailing out at tests/test-assert line 27. |
4055
|
|
|
|
|
|
|
Beginning stack dump in Assert::Conditional::Utils::botch at lib/Assert/Conditional/Utils.pm line 413, <DATA> line 1. |
4056
|
|
|
|
|
|
|
Assert::Conditional::Utils::botch('happy test $i > $j is sadly false') called at lib/Assert/Conditional.pm line 2558 |
4057
|
|
|
|
|
|
|
Assert::Conditional::_run_code_test('CODE(0x7f965a0025a0)', 1) called at lib/Assert/Conditional.pm line 2579 |
4058
|
|
|
|
|
|
|
Assert::Conditional::assert_happy_code('CODE(0x7f965a0025a0)') called at tests/test-assert line 27 |
4059
|
|
|
|
|
|
|
Anything::But::Main::Just::To::See::If::It::Works::check(1, 2, 3) called at tests/test-assert line 15 |
4060
|
|
|
|
|
|
|
|
4061
|
|
|
|
|
|
|
Here is that F<tests/test-assert> program: |
4062
|
|
|
|
|
|
|
|
4063
|
|
|
|
|
|
|
#!/usr/bin/env perl |
4064
|
|
|
|
|
|
|
package Anything::But::Main::Just::To::See::If::It::Works; |
4065
|
|
|
|
|
|
|
|
4066
|
|
|
|
|
|
|
use strict; |
4067
|
|
|
|
|
|
|
use warnings; |
4068
|
|
|
|
|
|
|
|
4069
|
|
|
|
|
|
|
use Assert::Conditional qw(:all) => -if => 1; |
4070
|
|
|
|
|
|
|
use Assert::Conditional qw(:argc) => -if => 0; |
4071
|
|
|
|
|
|
|
|
4072
|
|
|
|
|
|
|
my $data = <DATA>; |
4073
|
|
|
|
|
|
|
assert_bytes($data); |
4074
|
|
|
|
|
|
|
my ($i, $j) = (25, 624); |
4075
|
|
|
|
|
|
|
assert_numeric($_) for $i, $j; |
4076
|
|
|
|
|
|
|
my $a = check(1 .. 1+int(rand 3)); |
4077
|
|
|
|
|
|
|
exit(0); |
4078
|
|
|
|
|
|
|
|
4079
|
|
|
|
|
|
|
sub check { |
4080
|
|
|
|
|
|
|
assert_nonlist_context(); |
4081
|
|
|
|
|
|
|
assert_argc(); |
4082
|
|
|
|
|
|
|
assert_argc(37); |
4083
|
|
|
|
|
|
|
assert_argc_min(37); |
4084
|
|
|
|
|
|
|
my @args = @_; |
4085
|
|
|
|
|
|
|
print "check function called with @args\n"; |
4086
|
|
|
|
|
|
|
assert_open_handle(*DATA); |
4087
|
|
|
|
|
|
|
assert_happy_code {$i < $j}; |
4088
|
|
|
|
|
|
|
assert_happy_code {$i > $j}; |
4089
|
|
|
|
|
|
|
assert_unhappy_code {$i < $j}; |
4090
|
|
|
|
|
|
|
assert_unhappy_code {$i > $j}; |
4091
|
|
|
|
|
|
|
check_args(4, 2); |
4092
|
|
|
|
|
|
|
assert_array_length(@_); |
4093
|
|
|
|
|
|
|
assert_array_length(@_, 11); |
4094
|
|
|
|
|
|
|
assert_argc_minmax(-54, 10); |
4095
|
|
|
|
|
|
|
assert_unhappy_code(sub {$i < $j}); |
4096
|
|
|
|
|
|
|
assert_array_length_min(@_ => 20); |
4097
|
|
|
|
|
|
|
assert_class_method(); |
4098
|
|
|
|
|
|
|
assert_void_context(); |
4099
|
|
|
|
|
|
|
assert_list_context(); |
4100
|
|
|
|
|
|
|
assert_nonlist_context(); |
4101
|
|
|
|
|
|
|
assert_scalar_context(); |
4102
|
|
|
|
|
|
|
assert_nonvoid_context(); |
4103
|
|
|
|
|
|
|
assert_in_numeric_range($i, 10, 30); |
4104
|
|
|
|
|
|
|
assert_unhappy_code(\&check_args); |
4105
|
|
|
|
|
|
|
return undef; |
4106
|
|
|
|
|
|
|
} |
4107
|
|
|
|
|
|
|
|
4108
|
|
|
|
|
|
|
sub check_args { |
4109
|
|
|
|
|
|
|
print "checking args for oddity\n"; |
4110
|
|
|
|
|
|
|
assert_odd_number(int(rand(10))); |
4111
|
|
|
|
|
|
|
} |
4112
|
|
|
|
|
|
|
|
4113
|
|
|
|
|
|
|
__DATA__ |
4114
|
|
|
|
|
|
|
stuff |
4115
|
|
|
|
|
|
|
|
4116
|
|
|
|
|
|
|
The reason the first failure is C<< $i > $j >> one is because the earlier |
4117
|
|
|
|
|
|
|
assertions either passed (L</assert_nonlist_context>, L</assert_open_handle>) |
4118
|
|
|
|
|
|
|
or were skipped because argc assertions were explicitly disabled. |
4119
|
|
|
|
|
|
|
|
4120
|
|
|
|
|
|
|
However, if you instead ran the program this way, you would override that skipping of argc checked, |
4121
|
|
|
|
|
|
|
and so it would blow up right away there: |
4122
|
|
|
|
|
|
|
|
4123
|
|
|
|
|
|
|
$ ASSERT_CONDITIONAL=always perl -I lib tests/test-assert |
4124
|
|
|
|
|
|
|
test-assert[19107]: botched assertion assert_argc: Have 3 arguments but wanted 37, bailing out at tests/test-assert line 21. |
4125
|
|
|
|
|
|
|
Beginning stack dump in Assert::Conditional::Utils::botch at lib/Assert/Conditional/Utils.pm line 413, <DATA> line 1. |
4126
|
|
|
|
|
|
|
Assert::Conditional::Utils::botch('have 3 arguments but wanted 37') called at lib/Assert/Conditional/Utils.pm line 480 |
4127
|
|
|
|
|
|
|
Assert::Conditional::Utils::botch_have_thing_wanted('HAVE', 3, 'THING', 'argument', 'WANTED', 37) called at lib/Assert/Conditional/Utils.pm line 455 |
4128
|
|
|
|
|
|
|
Assert::Conditional::Utils::botch_argc(3, 37) called at lib/Assert/Conditional.pm line 2119 |
4129
|
|
|
|
|
|
|
Assert::Conditional::assert_argc(37) called at tests/test-assert line 21 |
4130
|
|
|
|
|
|
|
Anything::But::Main::Just::To::See::If::It::Works::check(1, 2, 3) called at tests/test-assert line 15 |
4131
|
|
|
|
|
|
|
|
4132
|
|
|
|
|
|
|
You can also disable all assertions completely, no matter the import was doing. Then they aren't ever called at all: |
4133
|
|
|
|
|
|
|
|
4134
|
|
|
|
|
|
|
$ ASSERT_CONDITIONAL=never perl -I lib tests/test-assert |
4135
|
|
|
|
|
|
|
check function called with 1 |
4136
|
|
|
|
|
|
|
checking args for oddity |
4137
|
|
|
|
|
|
|
|
4138
|
|
|
|
|
|
|
Finally, you can run with assertions in carp mode. This runs them all, but they never raise an exception. |
4139
|
|
|
|
|
|
|
Here's what an entire run would look like: |
4140
|
|
|
|
|
|
|
|
4141
|
|
|
|
|
|
|
$ ASSERT_CONDITIONAL=carp perl -I lib tests/test-assert |
4142
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_argc: Have 2 arguments but wanted 37 at tests/test-assert line 21. |
4143
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_argc_min: Have 2 arguments but wanted 37 or more at tests/test-assert line 22. |
4144
|
|
|
|
|
|
|
check function called with 1 2 |
4145
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_happy_code: Happy test { $i > $j } is sadly false at tests/test-assert line 27. |
4146
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_unhappy_code: Unhappy test { $i < $j } is sadly true at tests/test-assert line 28. |
4147
|
|
|
|
|
|
|
checking args for oddity |
4148
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_odd_number: 4 should be odd at tests/test-assert line 49. |
4149
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_array_length: Have 2 array elements but wanted 11 at tests/test-assert line 32. |
4150
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_nonnegative: -54 should not be negative at tests/test-assert line 33. |
4151
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_unhappy_code: Unhappy test { $i < $j } is sadly true at tests/test-assert line 34. |
4152
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_array_length_min: Have 2 array elements but wanted 20 or more at tests/test-assert line 35. |
4153
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_void_context: Wanted to be called in void context at tests/test-assert line 37. |
4154
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_list_context: Wanted to be called in list context at tests/test-assert line 38. |
4155
|
|
|
|
|
|
|
checking args for oddity |
4156
|
|
|
|
|
|
|
test-assert[19129]: botched assertion assert_unhappy_code: Unhappy test { Anything::But::Main::Just::To::See::If::It::Works::check_args() } is sadly true at tests/test-assert line 43. |
4157
|
|
|
|
|
|
|
|
4158
|
|
|
|
|
|
|
Notice how even though those assertions botch, they don't bail out of your program. |
4159
|
|
|
|
|
|
|
|
4160
|
|
|
|
|
|
|
=head1 ENVIRONMENT |
4161
|
|
|
|
|
|
|
|
4162
|
|
|
|
|
|
|
=head2 ASSERT_CONDITIONAL |
4163
|
|
|
|
|
|
|
|
4164
|
|
|
|
|
|
|
The C<ASSERT_CONDITIONAL> variable controls the behavior of the underlying |
4165
|
|
|
|
|
|
|
C<botch> function from L<Assert::Conditional::Utils>, and also of the the |
4166
|
|
|
|
|
|
|
conditional importing itself. If unset, assertions are on. |
4167
|
|
|
|
|
|
|
|
4168
|
|
|
|
|
|
|
Its allowable values are: |
4169
|
|
|
|
|
|
|
|
4170
|
|
|
|
|
|
|
=over |
4171
|
|
|
|
|
|
|
|
4172
|
|
|
|
|
|
|
=item ASSERT_CONDITIONAL=never |
4173
|
|
|
|
|
|
|
|
4174
|
|
|
|
|
|
|
Assertions are never imported, and even if you somehow manage to import |
4175
|
|
|
|
|
|
|
them, they will never never make a peep nor raise an exception. |
4176
|
|
|
|
|
|
|
|
4177
|
|
|
|
|
|
|
=item ASSERT_CONDITIONAL=always |
4178
|
|
|
|
|
|
|
|
4179
|
|
|
|
|
|
|
Assertions are always imported, and even if you somehow manage to avoid importing |
4180
|
|
|
|
|
|
|
them, they will still raise an exception on error. |
4181
|
|
|
|
|
|
|
|
4182
|
|
|
|
|
|
|
=item ASSERT_CONDITIONAL=carp |
4183
|
|
|
|
|
|
|
|
4184
|
|
|
|
|
|
|
Assertions are always imported but they do not raise an exception if they fail; |
4185
|
|
|
|
|
|
|
instead they all carp at you. This is true even if you manage to call an assertion |
4186
|
|
|
|
|
|
|
you haven't imported. |
4187
|
|
|
|
|
|
|
|
4188
|
|
|
|
|
|
|
=back |
4189
|
|
|
|
|
|
|
|
4190
|
|
|
|
|
|
|
=head2 ASSERT_CONDITIONAL_ALLOW_HANDLERS |
4191
|
|
|
|
|
|
|
|
4192
|
|
|
|
|
|
|
Normally, any user-registered pseudo-signal handlers in C<$SIG{__WARN__}> |
4193
|
|
|
|
|
|
|
or C<$SIG{__DIE__}> are locally ignored when a failed assertion needs to |
4194
|
|
|
|
|
|
|
generate a C<confess> (or under C<ASSERT_CONDITIONAL=carp>, a C<carp>). |
4195
|
|
|
|
|
|
|
|
4196
|
|
|
|
|
|
|
Enabling this option from the environment leaves those handlers active |
4197
|
|
|
|
|
|
|
instead, which for example means that if you have a C<$SIG{__WARN__}> |
4198
|
|
|
|
|
|
|
handler that promotes a warning into a dying, even a carped assertion |
4199
|
|
|
|
|
|
|
failure will kill you. |
4200
|
|
|
|
|
|
|
|
4201
|
|
|
|
|
|
|
=head2 ASSERT_CONDITIONAL_BUILD_POD |
4202
|
|
|
|
|
|
|
|
4203
|
|
|
|
|
|
|
This is used internally by the build tools to construct the pod for the |
4204
|
|
|
|
|
|
|
exporter tag groups. See the F<etc/generate-exporter-pod> script in the |
4205
|
|
|
|
|
|
|
module source directory, which sets that variable and then runs this very |
4206
|
|
|
|
|
|
|
module as an executable program instead of requiring it. Sneaky, I know. |
4207
|
|
|
|
|
|
|
|
4208
|
|
|
|
|
|
|
=head2 ASSERT_CONDITIONAL_DEBUG |
4209
|
|
|
|
|
|
|
|
4210
|
|
|
|
|
|
|
This adds some debugging used when for debugging the assertions themselves, |
4211
|
|
|
|
|
|
|
and in their import/export handling; These are also triggered by |
4212
|
|
|
|
|
|
|
C<$Exporter::Verbose>. |
4213
|
|
|
|
|
|
|
|
4214
|
|
|
|
|
|
|
Currently this is used only in the attribute handlers that register exports |
4215
|
|
|
|
|
|
|
during compile time. |
4216
|
|
|
|
|
|
|
|
4217
|
|
|
|
|
|
|
=head1 BACKGROUND NOTES |
4218
|
|
|
|
|
|
|
|
4219
|
|
|
|
|
|
|
Here are the design goals for C<Assert::Conditional>: |
4220
|
|
|
|
|
|
|
|
4221
|
|
|
|
|
|
|
=over |
4222
|
|
|
|
|
|
|
|
4223
|
|
|
|
|
|
|
=item * |
4224
|
|
|
|
|
|
|
|
4225
|
|
|
|
|
|
|
Make easy things easy: by making assertions so easy to write and so cheap |
4226
|
|
|
|
|
|
|
to use, no one will have any reason not to use them. |
4227
|
|
|
|
|
|
|
|
4228
|
|
|
|
|
|
|
=item * |
4229
|
|
|
|
|
|
|
|
4230
|
|
|
|
|
|
|
Pass as few arguments as you can to each assertion, and don't require |
4231
|
|
|
|
|
|
|
an easily forgotten C<... if DEBUG()> to disable them. |
4232
|
|
|
|
|
|
|
|
4233
|
|
|
|
|
|
|
=item * |
4234
|
|
|
|
|
|
|
|
4235
|
|
|
|
|
|
|
Create a rich set of assertions related to Perl code to check things |
4236
|
|
|
|
|
|
|
such as calling context, argument numbers and times, and various other |
4237
|
|
|
|
|
|
|
assumptions about the code or the data. |
4238
|
|
|
|
|
|
|
|
4239
|
|
|
|
|
|
|
These not only provide sanity checks while running, they also help make the |
4240
|
|
|
|
|
|
|
code more readable. If a boolean test were all that one ever needed, there |
4241
|
|
|
|
|
|
|
would only ever be a C<test_ok> function. Richer function names are |
4242
|
|
|
|
|
|
|
better. |
4243
|
|
|
|
|
|
|
|
4244
|
|
|
|
|
|
|
=item * |
4245
|
|
|
|
|
|
|
|
4246
|
|
|
|
|
|
|
Provide descriptive failure messages that help pinpoint the exact |
4247
|
|
|
|
|
|
|
error, not just "assertion failed". |
4248
|
|
|
|
|
|
|
|
4249
|
|
|
|
|
|
|
=item * |
4250
|
|
|
|
|
|
|
|
4251
|
|
|
|
|
|
|
Make assertions that can be made to disappear from your program |
4252
|
|
|
|
|
|
|
without any runtime cost if needed, yet which can also be re-enabled |
4253
|
|
|
|
|
|
|
through a runtime mechanism without touching the code. |
4254
|
|
|
|
|
|
|
|
4255
|
|
|
|
|
|
|
=item * |
4256
|
|
|
|
|
|
|
|
4257
|
|
|
|
|
|
|
Provide a way for assertions to be run and checked, but which |
4258
|
|
|
|
|
|
|
are not fatal to the program. (Raise no exception.) |
4259
|
|
|
|
|
|
|
|
4260
|
|
|
|
|
|
|
=item * |
4261
|
|
|
|
|
|
|
|
4262
|
|
|
|
|
|
|
Allow assertions to be enabled or disabled either I<en masse> or piecemeal, |
4263
|
|
|
|
|
|
|
picking and choosing from sets of related assertions to enable or disable. |
4264
|
|
|
|
|
|
|
In other words, make them work a bit like lexical warnings where you can |
4265
|
|
|
|
|
|
|
say give me all of this group, except for these ones. |
4266
|
|
|
|
|
|
|
|
4267
|
|
|
|
|
|
|
=item * |
4268
|
|
|
|
|
|
|
|
4269
|
|
|
|
|
|
|
Require no complicated framework setup to use. |
4270
|
|
|
|
|
|
|
|
4271
|
|
|
|
|
|
|
=item * |
4272
|
|
|
|
|
|
|
|
4273
|
|
|
|
|
|
|
Make it obvious what went wrong. |
4274
|
|
|
|
|
|
|
|
4275
|
|
|
|
|
|
|
=item * |
4276
|
|
|
|
|
|
|
|
4277
|
|
|
|
|
|
|
Keep the implementation of each assertion as short and simple as possible. |
4278
|
|
|
|
|
|
|
This documentation is much longer than the code itself. |
4279
|
|
|
|
|
|
|
|
4280
|
|
|
|
|
|
|
=item * |
4281
|
|
|
|
|
|
|
|
4282
|
|
|
|
|
|
|
Use nothing but Standard Perl save at great need. |
4283
|
|
|
|
|
|
|
|
4284
|
|
|
|
|
|
|
=item * |
4285
|
|
|
|
|
|
|
|
4286
|
|
|
|
|
|
|
Compatible to Perl version 5.10 whenever possible. (This didn't pan out; it needs 5.12.) |
4287
|
|
|
|
|
|
|
|
4288
|
|
|
|
|
|
|
=back |
4289
|
|
|
|
|
|
|
|
4290
|
|
|
|
|
|
|
The initial alpha release was considered completely experimental, but even |
4291
|
|
|
|
|
|
|
so all these goals were met. The only module required that is not part of |
4292
|
|
|
|
|
|
|
the standard Perl release is the underlying L<Exporter::ConditionalSubs> |
4293
|
|
|
|
|
|
|
which this module inherits its import method from. That module is where |
4294
|
|
|
|
|
|
|
(most of) the magic happens to make assertions get compiled out of your |
4295
|
|
|
|
|
|
|
program. You should look at that module for how the "conditional |
4296
|
|
|
|
|
|
|
importing" works. |
4297
|
|
|
|
|
|
|
|
4298
|
|
|
|
|
|
|
=head1 SEE ALSO |
4299
|
|
|
|
|
|
|
|
4300
|
|
|
|
|
|
|
=over |
4301
|
|
|
|
|
|
|
|
4302
|
|
|
|
|
|
|
=item * |
4303
|
|
|
|
|
|
|
|
4304
|
|
|
|
|
|
|
The L<Exporter::ConditionalSubs> module which this module is based on. |
4305
|
|
|
|
|
|
|
|
4306
|
|
|
|
|
|
|
=item * |
4307
|
|
|
|
|
|
|
|
4308
|
|
|
|
|
|
|
The L<Assert::Conditional::Utils> module provides some semi-standalone utility |
4309
|
|
|
|
|
|
|
functions. |
4310
|
|
|
|
|
|
|
|
4311
|
|
|
|
|
|
|
=back |
4312
|
|
|
|
|
|
|
|
4313
|
|
|
|
|
|
|
=head1 CAVEATS AND PROVISOS |
4314
|
|
|
|
|
|
|
|
4315
|
|
|
|
|
|
|
This is a beta release. |
4316
|
|
|
|
|
|
|
|
4317
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
4318
|
|
|
|
|
|
|
|
4319
|
|
|
|
|
|
|
Under versions of Perl previous to v5.12.1, Attribute::Handlers |
4320
|
|
|
|
|
|
|
blows up with an internal error about a symbol going missing. |
4321
|
|
|
|
|
|
|
|
4322
|
|
|
|
|
|
|
=head1 HISTORY |
4323
|
|
|
|
|
|
|
|
4324
|
|
|
|
|
|
|
0.001 6 June 2015 23:28 MDT |
4325
|
|
|
|
|
|
|
- Initial alpha release |
4326
|
|
|
|
|
|
|
|
4327
|
|
|
|
|
|
|
0.002 J June 2015 22:35 MDT |
4328
|
|
|
|
|
|
|
- MONGOLIAN VOWEL SEPARATOR is no longer whitespace in Unicode, so removed from test. |
4329
|
|
|
|
|
|
|
|
4330
|
|
|
|
|
|
|
0.003 Tue Jun 30 05:47:16 MDT 2015 |
4331
|
|
|
|
|
|
|
- Added assert_hash_keys_required and assert_hash_keys_allowed. |
4332
|
|
|
|
|
|
|
- Fixed some tests. |
4333
|
|
|
|
|
|
|
- Added bug report about Attribute::Handlers bug prior to 5.12. |
4334
|
|
|
|
|
|
|
|
4335
|
|
|
|
|
|
|
0.004 11 Feb 2018 11:18 MST |
4336
|
|
|
|
|
|
|
- Suppress overloading in botch messages for object-related assertions (but not others). |
4337
|
|
|
|
|
|
|
- Don't carp if we're throwing an exception and exceptions are trapped. |
4338
|
|
|
|
|
|
|
- Support more than one word in ASSERT_CONDITIONAL (eg: "carp,always"). |
4339
|
|
|
|
|
|
|
- If ASSERT_CONDITIONAL contains "handlers", don't block @SIG{__{WARN,DIE}__}. |
4340
|
|
|
|
|
|
|
- Don't let assert_isa die prematurely on an unblessed ref. |
4341
|
|
|
|
|
|
|
|
4342
|
|
|
|
|
|
|
0.005 Sun May 20 20:40:25 CDT 2018 |
4343
|
|
|
|
|
|
|
- Initial beta release. |
4344
|
|
|
|
|
|
|
- Reworked the hash key checkers into a simpler set: assert_keys, assert_min_keys, assert_max_keys, assert_minmax_keys. |
4345
|
|
|
|
|
|
|
- Added invocant-specific assertions: assert_{object,class}_{isa,ainta,can,cant}. |
4346
|
|
|
|
|
|
|
- Added assertions for ties, overloads, and locked hashes. |
4347
|
|
|
|
|
|
|
- Made assert_private_method work despite Moose wrappers. |
4348
|
|
|
|
|
|
|
- Added assert_protected_method that works despite Moose wrappers and roles. |
4349
|
|
|
|
|
|
|
- Improved the looks of the uncompiled code for assert_happy_code. |
4350
|
|
|
|
|
|
|
- Fixed botch() to identify the most distant stack frame not the nearest for the name of the failed assertion. |
4351
|
|
|
|
|
|
|
- Improved the reporting of some assertion failures. |
4352
|
|
|
|
|
|
|
|
4353
|
|
|
|
|
|
|
0.006 Mon May 21 07:45:43 CDT 2018 |
4354
|
|
|
|
|
|
|
- Use hash_{,un}locked not hashref_{,un}locked to support pre-5.16 perls. |
4355
|
|
|
|
|
|
|
- Unhid assert_unblessed_ref swallowed up by stray pod. |
4356
|
|
|
|
|
|
|
|
4357
|
|
|
|
|
|
|
0.007 Mon May 21 19:13:58 CDT 2018 |
4358
|
|
|
|
|
|
|
- Add missing Hash::Util version requirement for old perls to get hashref_unlock imported. |
4359
|
|
|
|
|
|
|
|
4360
|
|
|
|
|
|
|
0.008 Tue May 22 11:51:37 CDT 2018 |
4361
|
|
|
|
|
|
|
- Rewrite hash_unlocked missing till 5.16 as !hash_locked |
4362
|
|
|
|
|
|
|
- Add omitted etc/generate-exporter-pod to MANIFEST |
4363
|
|
|
|
|
|
|
|
4364
|
|
|
|
|
|
|
0.009 Tue Aug 21 06:29:56 MDT 2018 |
4365
|
|
|
|
|
|
|
- Delay slow calls to uca_sort till you really need them, credit Larry Leszczynski. |
4366
|
|
|
|
|
|
|
|
4367
|
|
|
|
|
|
|
0.010 Sun Jul 19 13:52:00 MDT 2020 |
4368
|
|
|
|
|
|
|
- Fix coredump in perl 5.12 by replacing UNITCHECK in Assert::Conditional::Util with normal execution at botton. |
4369
|
|
|
|
|
|
|
- Make perls below 5.18 work again by setting Hash::Util prereq in Makefile.PL to 0 because it's in the core only, never cpan. |
4370
|
|
|
|
|
|
|
- Only provide assert_locked and assert_unlocked if core Hash::Util v0.15 is there (starting perl v5.17). |
4371
|
|
|
|
|
|
|
- Bump version req of parent class Exporter::ConditionalSubs to v1.11.1 so we don't break Devel::Cover. |
4372
|
|
|
|
|
|
|
- Normalize Export sub attribute tracing so either $Exporter::Verbose=1 or env ASSERT_CONDITIONAL_DEBUG=1 work for both Assert::Conditional{,::Utils}. |
4373
|
|
|
|
|
|
|
- Mentioned $Exporter::Verbose support. |
4374
|
|
|
|
|
|
|
|
4375
|
|
|
|
|
|
|
=head1 AUTHOR |
4376
|
|
|
|
|
|
|
|
4377
|
|
|
|
|
|
|
Tom Christiansen C<< <tchrist53147@gmail.com> >> |
4378
|
|
|
|
|
|
|
|
4379
|
|
|
|
|
|
|
Thanks to Larry Leszczynski at Grant Street Group for making this module |
4380
|
|
|
|
|
|
|
possible. Without it, my programs would be much slower, since before I |
4381
|
|
|
|
|
|
|
added his module to my old and pre-existing assertion system, the |
4382
|
|
|
|
|
|
|
assertions alone were taking up far too much CPU time. |
4383
|
|
|
|
|
|
|
|
4384
|
|
|
|
|
|
|
=head1 LICENCE AND COPYRIGHT |
4385
|
|
|
|
|
|
|
|
4386
|
|
|
|
|
|
|
Copyright (c) 2015-2018, Tom Christiansen C<< <tchrist@perl.com> >>. |
4387
|
|
|
|
|
|
|
All Rights Reserved. |
4388
|
|
|
|
|
|
|
|
4389
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |