File Coverage

blib/lib/Assert/Conditional.pm
Criterion Covered Total %
statement 1268 1281 98.9
branch 345 374 92.2
condition 75 96 78.1
subroutine 399 400 99.7
pod 175 177 98.8
total 2262 2328 97.1


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