Assert-Conditional
view release on metacpan or search on metacpan
lib/Assert/Conditional.pm view on Meta::CPAN
#!/usr/bin/env perl
# ^^^^^^ !!!!!! ^^^^^^^
# Yes, this module really is supposed to have a #!
# line and be an executable script. See the end of the file
# for why!
package Assert::Conditional;
use v5.12;
use utf8;
use strict;
use warnings;
use version 0.77;
our $VERSION = version->declare("0.010");
use parent "Exporter::ConditionalSubs"; # inherits from Exporter
use namespace::autoclean;
use Attribute::Handlers;
use Assert::Conditional::Utils ":all";
use Carp qw(carp croak cluck confess);
use POSIX ":sys_wait_h";
use Scalar::Util qw{
blessed
looks_like_number
openhandle
refaddr
reftype
};
use Unicode::Normalize qw{
NFC checkNFC
NFD checkNFD
NFKC checkNFKC
NFKD checkNFKD
};
# But these are private internal functions that we
# choose not to expose even if fully qualified,
# and so declaring them here in front of the
# imminent namespace::clean will make sure of that.
sub _coredump_message ( ;$ ) ;
sub _get_invocant_type ( $ ) ;
sub _promote_to_arrayref ( $ ) ;
sub _promote_to_hashref ( $ ) ;
sub _promote_to_typeref ( $$ ) ;
sub _run_code_test ( $$ ) ;
sub _signum_message ( $ ) ;
sub _WIFCORED ( ;$ ) ;
# Need to be able to measure coverage with Devel::Cover
# of stuff we would normally get rid of.
use if !$ENV{HARNESS_ACTIVE}, "namespace::clean";
#######################################################################
# First declare our Exporter vars:
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
# Then thanks to this little guy....
sub Assert;
# Now those have by now all been fully populated *during compilation*,
# so it only remains to re-collate them into pleasant alphabetic order:
@$_ = uca_sort @$_ for \@EXPORT_OK, values %EXPORT_TAGS;
sub assert_ainta ( $@ ) ;
sub assert_alnum ( $ ) ;
sub assert_alphabetic ( $ ) ;
sub assert_anyref ( $ ) ;
sub assert_argc ( ;$ ) ;
sub assert_argc_max ( $ ) ;
sub assert_argc_min ( $ ) ;
sub assert_argc_minmax ( $$ ) ;
sub assert_array_length ( \@ ;$ ) ;
sub assert_array_length_max ( \@ $ ) ;
sub assert_array_length_min ( \@ $ ) ;
sub assert_array_length_minmax ( \@ $$ ) ;
sub assert_array_nonempty ( \@ ) ;
sub assert_arrayref ( $ ) ;
sub assert_arrayref_nonempty ( $ ) ;
sub assert_ascii ( $ ) ;
sub assert_ascii_ident ( $ ) ;
sub assert_astral ( $ ) ;
lib/Assert/Conditional.pm view on Meta::CPAN
:Assert( qw[scalar boolean] )
{
my($arg) = @_;
$arg && botch "expected true argument";
}
sub assert_defined($)
:Assert( qw[scalar] )
{
my($value) = @_;
defined($value) || botch "expected defined value as argument";
}
sub assert_undefined($)
:Assert( qw[scalar] )
{
my($scalar) = @_;
defined($scalar) && botch "expected undefined argument";
}
sub assert_defined_variable(\$)
:Assert( qw[scalar] )
{
&assert_scalarref;
my($sref) = @_;
defined($$sref) || botch "expected defined scalar variable as argument";
}
sub assert_defined_value($)
:Assert( qw[scalar] )
{
my($value) = @_;
defined($value) || botch "expected defined value as argument";
}
sub assert_is($$)
:Assert( qw[string] )
{
my($this, $that) = @_;
assert_defined($_) for $this, $that;
assert_nonref($_) for $this, $that;
$this eq $that || botch "string '$this' should be '$that'";
}
sub assert_isnt($$)
:Assert( qw[string] )
{
my($this, $that) = @_;
assert_defined($_) for $this, $that;
assert_nonref($_) for $this, $that;
$this ne $that || botch "string '$this' should not be '$that'";
}
sub assert_numeric($)
:Assert( qw[number] )
{
&assert_defined;
&assert_nonref;
my($n) = @_;
looks_like_number($n) || botch "'$n' doesn't look like a number";
}
sub assert_nonnumeric($)
:Assert( qw[number] )
{
&assert_nonref;
my($n) = @_;
!looks_like_number($n) || botch "'$n' looks like a number";
}
sub assert_positive($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n > 0 || botch "$n should be positive";
}
sub assert_nonpositive($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n <= 0 || botch "$n should not be positive";
}
sub assert_negative($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n < 0 || botch "$n should be negative";
}
sub assert_nonnegative($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n >= 0 || botch "$n should not be negative";
}
sub assert_zero($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n == 0 || botch "$n should be zero";
}
sub assert_nonzero($)
:Assert( qw[number] )
{
&assert_numeric;
my($n) = @_;
$n != 0 || botch "$n should not be zero";
}
sub assert_integer($)
:Assert( qw[number] )
{
&assert_numeric;
my($int) = @_;
$int == int($int) || botch "expected integer, not $int";
}
sub assert_fractional($)
:Assert( qw[number] )
lib/Assert/Conditional.pm view on Meta::CPAN
(C<q()> and C<!1>), the string of length one whose only character is an
ASCII C<DIGIT ZERO>, and those numbers which evaluate to zero. Strings
that evaluate to numeric zero other than the previously stated exemption
are not false, such as the notorious value C<"0 but true"> sometimes
returned by the C<ioctl>, C<fcntl>, and C<syscall> system calls.
=item assert_defined(I<EXPR>)
The scalar I<EXPR> argument is defined. Consider using one of either
L</assert_defined_variable> or L</assert_defined_value> to better
document your intention.
=item assert_undefined(I<EXPR>)
The scalar I<EXPR> argument is not defined.
=item assert_defined_variable(I<SCALAR>)
The scalar B<variable> argument I<SCALAR> is defined. This is safer to
call than L</assert_defined_value> because it requires an actual scalar
variable with a leading dollar sign, so generates a compiler error if you
try to pass it other sigils.
=item assert_defined_value(I<EXPR>)
The scalar I<EXPR> is defined.
=item assert_is(I<THIS>, I<THAT>)
The two defined non-ref arguments test true for "string equality", codepoint
by codepoint, using the built-in C<eq> operator.
When called on objects with operator overloads, their C<eq> overload or if
necessary their stringification overloads will thereofre be honored but
this test is not otherwise in any fashion recursive or object-aware.
This is not the same as equivalent Unicode strings. For that, use
L</assert_eq> to compare normalized Unicode strings, and use
L</assert_eq_letters> to compare only their letters but disregard the rest.
=item assert_isnt(I<THIS>, I<THAT>)
The two defined non-ref arguments test false for string equality with the
C<ne> operator. The expected overloads are therefore honored, but this
test is not otherwise in any fashion recursive or object-aware.
=back
=head2 Assertions about Numbers
Most of the assertions in this section treat their arguments as numbers.
When called on objects with operator overloads, their evaluation will
therefore trigger a C<0+> nummification overload in preference to a C<"">
stringification overload if the former exists. Otherwise normal fallback
rules apply as documented in the L<overload> pragma.
=over
=item assert_numeric(I<EXPR>)
The defined non-ref argument looks like a number suitable for implicit
conversion according to the builtin L<Scalar::Util/looks_like_number>
predicate.
=item assert_nonnumeric(I<EXPR>)
The defined non-ref argument does I<not> look like a number suitable for
implicit conversion, again per L<Scalar::Util/looks_like_number>.
=item assert_positive(I<EXPR>)
The defined non-ref argument is numerically greater than zero.
=item assert_nonpositive(I<EXPR>)
The defined non-ref argument is numerically less than or equal to zero.
=item assert_negative(I<EXPR>)
The defined non-ref argument is numerically less than zero.
=item assert_nonnegative(I<EXPR>)
The defined non-ref argument is numerically greater than or equal to
numeric zero.
=item assert_zero(I<EXPR>)
The defined non-ref argument is numerically equal to numeric zero.
=item assert_nonzero(I<EXPR>)
The defined non-ref argument is not numerically equal to numeric zero.
=item assert_integer(I<EXPR>)
The defined non-ref numeric argument has no fractional part.
=item assert_fractional(I<EXPR>)
The defined non-ref numeric argument has a fractional part.
=item assert_signed_number(I<EXPR>)
The defined non-ref numeric argument has a leading sign, ASCII C<-> or
C<+>. A Unicode C<MINUS SIGN> does not currently count because Perl will
not respect it for implicit string-to-number conversions.
=item assert_natural_number(I<EXPR>)
One of the counting numbers: 1, 2, 3, . . .
=item assert_whole_number(I<EXPR>)
A natural number or zero.
=item assert_positive_integer(I<EXPR>)
An integer greater than zero.
=item assert_nonpositive_integer(I<EXPR>)
An integer not greater than zero.
=item assert_negative_integer(I<EXPR>)
An integer less than zero.
lib/Assert/Conditional.pm view on Meta::CPAN
The initial alpha release was considered completely experimental, but even
so all these goals were met. The only module required that is not part of
the standard Perl release is the underlying L<Exporter::ConditionalSubs>
which this module inherits its import method from. That module is where
(most of) the magic happens to make assertions get compiled out of your
program. You should look at that module for how the "conditional
importing" works.
=head1 SEE ALSO
=over
=item *
The L<Exporter::ConditionalSubs> module which this module is based on.
=item *
The L<Assert::Conditional::Utils> module provides some semi-standalone utility
functions.
=back
=head1 CAVEATS AND PROVISOS
This is a beta release.
=head1 BUGS AND LIMITATIONS
Under versions of Perl previous to v5.12.1, Attribute::Handlers
blows up with an internal error about a symbol going missing.
=head1 HISTORY
0.001 6 June 2015 23:28 MDT
- Initial alpha release
0.002 J June 2015 22:35 MDT
- MONGOLIAN VOWEL SEPARATOR is no longer whitespace in Unicode, so removed from test.
0.003 Tue Jun 30 05:47:16 MDT 2015
- Added assert_hash_keys_required and assert_hash_keys_allowed.
- Fixed some tests.
- Added bug report about Attribute::Handlers bug prior to 5.12.
0.004 11 Feb 2018 11:18 MST
- Suppress overloading in botch messages for object-related assertions (but not others).
- Don't carp if we're throwing an exception and exceptions are trapped.
- Support more than one word in ASSERT_CONDITIONAL (eg: "carp,always").
- If ASSERT_CONDITIONAL contains "handlers", don't block @SIG{__{WARN,DIE}__}.
- Don't let assert_isa die prematurely on an unblessed ref.
0.005 Sun May 20 20:40:25 CDT 2018
- Initial beta release.
- Reworked the hash key checkers into a simpler set: assert_keys, assert_min_keys, assert_max_keys, assert_minmax_keys.
- Added invocant-specific assertions: assert_{object,class}_{isa,ainta,can,cant}.
- Added assertions for ties, overloads, and locked hashes.
- Made assert_private_method work despite Moose wrappers.
- Added assert_protected_method that works despite Moose wrappers and roles.
- Improved the looks of the uncompiled code for assert_happy_code.
- Fixed botch() to identify the most distant stack frame not the nearest for the name of the failed assertion.
- Improved the reporting of some assertion failures.
0.006 Mon May 21 07:45:43 CDT 2018
- Use hash_{,un}locked not hashref_{,un}locked to support pre-5.16 perls.
- Unhid assert_unblessed_ref swallowed up by stray pod.
0.007 Mon May 21 19:13:58 CDT 2018
- Add missing Hash::Util version requirement for old perls to get hashref_unlock imported.
0.008 Tue May 22 11:51:37 CDT 2018
- Rewrite hash_unlocked missing till 5.16 as !hash_locked
- Add omitted etc/generate-exporter-pod to MANIFEST
0.009 Tue Aug 21 06:29:56 MDT 2018
- Delay slow calls to uca_sort till you really need them, credit Larry Leszczynski.
0.010 Sun Jul 19 13:52:00 MDT 2020
- Fix coredump in perl 5.12 by replacing UNITCHECK in Assert::Conditional::Util with normal execution at botton.
- 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.
- Only provide assert_locked and assert_unlocked if core Hash::Util v0.15 is there (starting perl v5.17).
- Bump version req of parent class Exporter::ConditionalSubs to v1.11.1 so we don't break Devel::Cover.
- Normalize Export sub attribute tracing so either $Exporter::Verbose=1 or env ASSERT_CONDITIONAL_DEBUG=1 work for both Assert::Conditional{,::Utils}.
- Mentioned $Exporter::Verbose support.
=head1 AUTHOR
Tom Christiansen C<< <tchrist53147@gmail.com> >>
Thanks to Larry Leszczynski at Grant Street Group for making this module
possible. Without it, my programs would be much slower, since before I
added his module to my old and pre-existing assertion system, the
assertions alone were taking up far too much CPU time.
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2015-2018, Tom Christiansen C<< <tchrist@perl.com> >>.
All Rights Reserved.
This module is free software; you can redistribute it and/or
( run in 0.459 second using v1.01-cache-2.11-cpan-39bf76dae61 )