Assert-Conditional
view release on metacpan or search on metacpan
lib/Assert/Conditional.pm view on Meta::CPAN
sub assert_tied_globref ( $ ) ;
sub assert_tied_hash ( \% ) ;
sub assert_tied_hashref ( $ ) ;
sub assert_tied_referent ( $ ) ;
sub assert_tied_scalar ( \$ ) ;
sub assert_tied_scalarref ( $ ) ;
sub assert_true ( $ ) ;
sub assert_unblessed_ref ( $ ) ;
sub assert_undefined ( $ ) ;
sub assert_unhappy_code ( & ) ;
sub assert_unicode_ident ( $ ) ;
sub assert_unlike ( $$ ) ;
sub assert_unlocked ( \[%$] @ ) ;
sub assert_unsignalled ( ;$ ) ;
sub assert_untied ( \[$@%*] ) ;
sub assert_untied_array ( \@ ) ;
sub assert_untied_arrayref ( $ ) ;
sub assert_untied_glob ( \* ) ;
sub assert_untied_globref ( $ ) ;
sub assert_untied_hash ( \% ) ;
sub assert_untied_hashref ( $ ) ;
lib/Assert/Conditional.pm view on Meta::CPAN
sub assert_lowercased($)
:Assert( qw[case regex] )
{
local($_) = @_;
($] >= 5.014
? ! /\p{Changes_When_Lowercased}/
: $_ eq lc ) || botch "changes case when lowercased";
}
sub assert_unicode_ident($)
:Assert( qw[regex] )
{
local($_) = @_;
/^ \p{XID_Start} \p{XID_Continue}* \z/x
|| botch "invalid identifier $_";
}
# This is a lie.
my $perl_simple_ident_rx = qr{
\b
lib/Assert/Conditional.pm view on Meta::CPAN
:Assert( qw[regex] )
{
my($string, $pattern) = @_;
assert_defined($string);
assert_nonref($string);
assert_regex($pattern);
$string !~ $pattern || botch "'$string' should not match $pattern";
}
sub assert_latin1($)
:Assert( qw[string unicode] )
{
&assert_bytes;
}
sub assert_latinish($)
:Assert( qw[unicode] )
{
local($_) = @_;
/^[\p{Latin}\p{Common}\p{Inherited}]+/
|| botch "expected only Latinish characters in string";
}
sub assert_astral($)
:Assert( qw[unicode] )
{
local($_) = @_;
no warnings "utf8"; # early versions of perl complain of illegal for interchange on FFFF
/[^\x00-\x{FFFF}]/x || botch "expected non-BMP characters in string";
}
sub assert_nonastral($)
:Assert( qw[unicode] )
{
local($_) = @_;
no warnings "utf8"; # early versions of perl complain of illegal for interchange on FFFF
/^ [\x00-\x{FFFF}] * \z/x || botch "unexpected non-BMP characters in string";
}
sub assert_bmp($)
:Assert( qw[unicode] )
{
&assert_nonastral;
}
sub assert_nfc($)
:Assert( qw[unicode] )
{
my($str) = @_;
checkNFC($str) // $str eq NFC($str)
|| botch "string not in NFC form";
}
sub assert_nfkc($)
:Assert( qw[unicode] )
{
my($str) = @_;
checkNFKC($str) // $str eq NFKC($str)
|| botch "string not in NFKC form";
}
sub assert_nfd($)
:Assert( qw[unicode] )
{
my($str) = @_;
checkNFD($str) || botch "string not in NFD form";
}
sub assert_nfkd($)
:Assert( qw[unicode] )
{
my($str) = @_;
checkNFKD($str) || botch "string not in NFKD form";
}
sub assert_eq($$)
:Assert( qw[string unicode] )
{
my($this, $that) = @_;
NFC($this) eq NFC($that) || botch "'$this' and '$that' are not equivalent Unicode strings";
}
sub assert_eq_letters($$)
:Assert( qw[string unicode] )
{
my($this, $that) = @_;
UCA1($this) eq UCA1($that) || botch "'$this' and '$that' do not equivalent letters"
}
sub assert_in_list($@)
:Assert( qw[list] )
{
my($needle, @haystack) = @_;
#assert_nonref($needle);
lib/Assert/Conditional.pm view on Meta::CPAN
assert_tied_globref ( $ ) ;
assert_tied_hash ( \% ) ;
assert_tied_hashref ( $ ) ;
assert_tied_referent ( $ ) ;
assert_tied_scalar ( \$ ) ;
assert_tied_scalarref ( $ ) ;
assert_true ( $ ) ;
assert_unblessed_ref ( $ ) ;
assert_undefined ( $ ) ;
assert_unhappy_code ( & ) ;
assert_unicode_ident ( $ ) ;
assert_unlike ( $$ ) ;
assert_unlocked ( \[%$] @ ) ;
assert_unsignalled ( ;$ ) ;
assert_untied ( \[$@%*] ) ;
assert_untied_array ( \@ ) ;
assert_untied_arrayref ( $ ) ;
assert_untied_glob ( \* ) ;
assert_untied_globref ( $ ) ;
assert_untied_hash ( \% ) ;
assert_untied_hashref ( $ ) ;
lib/Assert/Conditional.pm view on Meta::CPAN
L</assert_public_method>, L</assert_qualified_ident>, L</assert_refref>,
L</assert_reftype>, L</assert_regex>, L</assert_regular_file>,
L</assert_sad_exit>, L</assert_scalar_context>, L</assert_scalarref>,
L</assert_signalled>, L</assert_signed_number>,
L</assert_simple_perl_ident>, L</assert_single_line>,
L</assert_single_paragraph>, L</assert_text_file>, L</assert_tied>,
L</assert_tied_array>, L</assert_tied_arrayref>, L</assert_tied_glob>,
L</assert_tied_globref>, L</assert_tied_hash>, L</assert_tied_hashref>,
L</assert_tied_referent>, L</assert_tied_scalar>,
L</assert_tied_scalarref>, L</assert_true>, L</assert_unblessed_ref>,
L</assert_undefined>, L</assert_unhappy_code>, L</assert_unicode_ident>,
L</assert_unlike>, L</assert_unlocked>, L</assert_unsignalled>,
L</assert_untied>, L</assert_untied_array>, L</assert_untied_arrayref>,
L</assert_untied_glob>, L</assert_untied_globref>, L</assert_untied_hash>,
L</assert_untied_hashref>, L</assert_untied_referent>,
L</assert_untied_scalar>, L</assert_untied_scalarref>,
L</assert_uppercased>, L</assert_void_context>, L</assert_whole_number>,
L</assert_wide_characters>, and L</assert_zero>.
=item C<:argc>
lib/Assert/Conditional.pm view on Meta::CPAN
L</assert_untied_scalarref>.
=item C<:regex>
L</assert_alnum>, L</assert_alphabetic>, L</assert_ascii>,
L</assert_ascii_ident>, L</assert_blank>, L</assert_digits>,
L</assert_full_perl_ident>, L</assert_hex_number>, L</assert_like>,
L</assert_lowercased>, L</assert_multi_line>, L</assert_nonalphabetic>,
L</assert_nonascii>, L</assert_nonblank>, L</assert_qualified_ident>,
L</assert_regex>, L</assert_simple_perl_ident>, L</assert_single_line>,
L</assert_single_paragraph>, L</assert_unicode_ident>, L</assert_unlike>,
and L</assert_uppercased>.
=item C<:scalar>
L</assert_defined>, L</assert_defined_value>, L</assert_defined_variable>,
L</assert_false>, L</assert_scalarref>, L</assert_tied_scalar>,
L</assert_tied_scalarref>, L</assert_true>, L</assert_undefined>,
L</assert_untied_scalar>, and L</assert_untied_scalarref>.
=item C<:string>
lib/Assert/Conditional.pm view on Meta::CPAN
L</assert_tied>, L</assert_tied_array>, L</assert_tied_arrayref>,
L</assert_tied_glob>, L</assert_tied_globref>, L</assert_tied_hash>,
L</assert_tied_hashref>, L</assert_tied_referent>, L</assert_tied_scalar>,
L</assert_tied_scalarref>, L</assert_untied>, L</assert_untied_array>,
L</assert_untied_arrayref>, L</assert_untied_glob>,
L</assert_untied_globref>, L</assert_untied_hash>,
L</assert_untied_hashref>, L</assert_untied_referent>,
L</assert_untied_scalar>, and L</assert_untied_scalarref>.
=item C<:unicode>
L</assert_astral>, L</assert_bmp>, L</assert_eq>, L</assert_eq_letters>,
L</assert_latin1>, L</assert_latinish>, L</assert_nfc>, L</assert_nfd>,
L</assert_nfkc>, L</assert_nfkd>, and L</assert_nonastral>.
=back
=head2 Assertions about Calling Context
These assertions inspect their immediate caller’s C<wantarray>.
lib/Assert/Conditional.pm view on Meta::CPAN
Argument contains only ASCII digits.
=item assert_uppercased(I<EXPR>)
Argument will not change if uppercased.
=item assert_lowercased(I<EXPR>)
Argument will not change if lowercased.
=item assert_unicode_ident(I<EXPR>)
Argument is a legal Unicode identifier, so one beginning with an (X)ID Start
code point and having any number of (X)ID Continue code points following.
Note that Perl identifiers are somewhat different from this.
=item assert_simple_perl_ident(I<EXPR>)
Like a Unicode identifier but which may also start
with connector punctuation like underscores. No package
separators are allowed, however. Sigils do not count.
lib/Assert/Conditional/Utils.pm view on Meta::CPAN
else {
print "Conditional export tag :$tag exports ", commify_series(uca_sort @$aref), ".\n";
}
}
print "=back\n\n" if $Pod_Generation;
return $errors == 0;
}
#################################################################
sub UCA (_) :Export( qw[unicode] );
sub UCA1(_) :Export( qw[unicode] );
sub UCA2(_) :Export( qw[unicode] );
sub UCA3(_) :Export( qw[unicode] );
sub UCA4(_) :Export( qw[unicode] );
sub uca_cmp ($$) :Export( qw[unicode] );
sub uca1_cmp($$) :Export( qw[unicode] );
sub uca2_cmp($$) :Export( qw[unicode] );
sub uca3_cmp($$) :Export( qw[unicode] );
sub uca4_cmp($$) :Export( qw[unicode] );
{
my @Comparitor;
sub _get_comparitor($) {
my($level) = @_;
panic "invalid level $level" unless $level =~ /^[1-4]$/;
return $Comparitor[$level] if $Comparitor[$level];
require Unicode::Collate;
lib/Assert/Conditional/Utils.pm view on Meta::CPAN
};
}
no warnings "once";
*UCA = \&UCA1;
*uca_cmp = \&uca1_cmp;
}
sub uca_sort(@)
:Export( qw[unicode list] )
{
state $collator = _get_comparitor(4);
return $collator->sort(@_);
}
{
sub _uniq {
my %seen;
my @out;
for (@_) { push @out, $_ unless $seen{$_}++ }
lib/Assert/Conditional/Utils.pm view on Meta::CPAN
=item C<:list>
L</commify_and>, L</commify_but>, L</commify_nor>, L</commify_or>,
L</commify_series>, L</quotify_and>, L</quotify_but>, L</quotify_nor>,
L</quotify_or>, and L</uca_sort>.
=item C<:sigmappers>
L</sig_name2num>, L</sig_num2longname>, and L</sig_num2name>.
=item C<:unicode>
L</UCA>, L</UCA1>, L</uca1_cmp>, L</UCA2>, L</uca2_cmp>, L</UCA3>,
L</uca3_cmp>, L</UCA4>, L</uca4_cmp>, L</uca_cmp>, and L</uca_sort>.
=item C<:vars>
L</$Allow_Handlers>, L</$Assert_Always>, L</$Assert_Carp>,
L</$Assert_Debug>, and L</$Assert_Never>.
=back
t/asserts.t view on Meta::CPAN
q{assert_nonbytes("\x{223}")},
q{assert_wide_characters("\x{223}")},
q{assert_nonascii("\x{223}")},
q{assert_ascii("zzz")},
q{assert_alphabetic("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_nonalphabetic("~!")},
q{assert_alnum("abc39sd")},
q{assert_digits("12349120")},
q{assert_uppercased("THIS OLD MAN!")},
q{assert_lowercased("this old man!")},
q{assert_unicode_ident("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_simple_perl_ident("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_full_perl_ident("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_qualified_ident("main::ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_ascii_ident("nino")},
q{assert_regex(qr/foo/)},
q{assert_like("foo", qr/f/)},
q{assert_unlike("foo", qr/z/)},
q{assert_latin1("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_latinish("Henry \N{ROMAN NUMERAL EIGHT}")},
t/asserts.t view on Meta::CPAN
q{assert_scalarref()},
q{assert_signed_number()},
q{assert_signed_number(42)},
q{assert_simple_perl_ident()},
q{assert_single_line()},
q{assert_single_paragraph()},
q{assert_text_file()},
q{assert_true()},
q{assert_undefined()},
q{assert_unhappy_code()},
q{assert_unicode_ident()},
q{assert_unlike()},
q{assert_uppercased()},
q{assert_whole_number()},
q{assert_wide_characters()},
q{assert_zero()},
q{assert_is($one, $two)},
q{assert_is($one, $undef)},
q{assert_defined(undef) },
q{assert_defined($undef) },
q{assert_defined_value(undef) },
t/asserts.t view on Meta::CPAN
q{assert_wide_characters("x")},
q{assert_nonascii("223")},
q{assert_ascii("\xa0")},
q{assert_nonalphabetic("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_alphabetic("~!")},
q{assert_alnum("abc%39sd")},
q{assert_digits("1234asbc9120")},
q{assert_lowercased("THIS OLD MAN!")},
q{assert_uppercased("this old man!")},
q{assert_uppercased("BA\N{LATIN SMALL LETTER SHARP S}")},
q{assert_unicode_ident("_ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_simple_perl_ident("ni\xa2o")},
q{assert_full_perl_ident("ni\xa2o")},
q{assert_qualified_ident("main::ni\xa2o")},
q{assert_qualified_ident("main")},
q{assert_ascii_ident("ni\N{LATIN SMALL LETTER N WITH TILDE}o")},
q{assert_regex(q/foo/)},
q{assert_like("foo", q/f/)},
q{assert_like("foo", qr/z/)},
q{assert_unlike("foo", qr/f/)},
q{assert_latin1("\x{189}")},
( run in 0.532 second using v1.01-cache-2.11-cpan-88abd93f124 )