Carp-Assert-More-2.9.0/0000755000101700007640000000000014762222357013737 5ustar alesterispcCarp-Assert-More-2.9.0/t/0000755000101700007640000000000014762222356014201 5ustar alesterispcCarp-Assert-More-2.9.0/t/assert_arrayref_of.t0000644000101700007640000000254714762221651020253 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [@_], $class; } package main; use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; MAIN: { # {} is not an arrayref. throws_ok( sub { assert_arrayref_of( {}, 'Foo' ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref_of( $ref, 'Foo' ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref_of( 3, 'Foo' ) }, $FAILED ); # [] is a nonempty arrayref. lives_ok( sub { assert_arrayref_of( [ Foo->new ], 'Foo' ) } ); # [] is an empty arrayref. lives_ok( sub { assert_arrayref_of( [], 'Foo' ) }, $FAILED ); my @empty_ary; lives_ok( sub { assert_arrayref_of( \@empty_ary, 'Foo' ) }, $FAILED ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref_of( $coderef, 'Foo' ) }, $FAILED ); } WHICH_ELEMENT: { lives_ok( sub { assert_arrayref_of( [ Foo->new, Foo->new ], 'Foo' ) } ); # Check for both parts of the message. throws_ok( sub { assert_arrayref_of( [ Foo->new, Foo->new, {} ], 'Foo' ) }, $FAILED ); throws_ok( sub { assert_arrayref_of( [ Foo->new, Foo->new, {} ], 'Foo' ) }, qr/Element #2/ ); } exit 0; Carp-Assert-More-2.9.0/t/00-load.t0000644000101700007640000000031114733067030015507 0ustar alesterispc#!perl use Test::More tests => 1; use Carp::Assert::More; diag( "Testing Carp::Assert::More $Carp::Assert::More::VERSION, Test::More $Test::More::VERSION, Perl $], $^X" ); pass( 'Module loaded' ); Carp-Assert-More-2.9.0/t/assert_integer.t0000644000101700007640000000136714733067030017405 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, PASS ], [ 0.4, FAIL ], [ -10, PASS ], [ 'dog', FAIL ], [ '14.', FAIL ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_integer( $val ) }; if ( $status eq FAIL ) { throws_ok( sub { assert_integer( $val ) }, qr/Assertion.+failed/, $desc ); } else { lives_ok( sub { assert_integer( $val ) }, $desc ); } } Carp-Assert-More-2.9.0/t/assert_numeric.t0000644000101700007640000000136714733067030017412 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 21; use Carp::Assert::More; use Test::Exception; my @good = ( 1, 2112, '2112', 3.1415926, -5150, '-0.12', '0.12', 2.112E+03, 2.112E3, 2.112e3, 2.112e0, 2.112e-1, ); my @bad = ( undef, 'zero', '', [], {}, \99, \*STDIN, '3-5', 3.5.4 ); for my $good ( @good ) { lives_ok( sub { assert_numeric( $good, "$good is good" ) }, "$good passes assertion" ); } for my $bad ( @bad ) { my $disp = $bad; $disp = '' unless defined $disp; throws_ok( sub { assert_numeric( $bad, "$disp is bad" ) }, qr/\Q$disp is bad/, "$disp fails assertion" ); } exit 0; Carp-Assert-More-2.9.0/t/assert_coderef.t0000644000101700007640000000173314733067030017354 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless sub {}, $class; } package main; use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; local $@; $@ = ''; # {} is not a coderef eval { assert_coderef( {} ); }; like( $@, qr/Assertion.*failed/ ); # a ref to a hash with stuff in it is not a coderef my $ref = { foo => 'foo', bar => 'bar' }; eval { assert_coderef( $ref ); }; like( $@, qr/Assertion.*failed/ ); # 3 is not a coderef eval { assert_coderef( 3 ); }; like( $@, qr/Assertion.*failed/ ); # [] is not a coderef eval { assert_coderef( [] ); }; like( $@, qr/Assertion.*failed/ ); # a ref to a list with stuff in it is not a coderef my @ary = ('foo', 'bar', 'baaz'); eval { assert_coderef( \@ary ); }; like( $@, qr/Assertion.*failed/ ); # sub {} is a coderef eval { assert_coderef( sub {} ); }; is( $@, '' ); # Foo->new->isa("CODE") returns true, so do we eval { assert_coderef( Foo->new ); }; is( $@, '' ); Carp-Assert-More-2.9.0/t/assert_hashref.t0000644000101700007640000000155614733067030017370 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless {@_}, $class; } package main; use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; # {} is a hashref lives_ok( sub { assert_hashref( {} ) } ); # A ref to a hash with stuff in it is a hashref. my %hash = ( foo => 'foo', bar => 'bar' ); lives_ok( sub { assert_hashref( \%hash ) } ); # 3 is not a hashref. throws_ok( sub { assert_hashref( 3 ) }, $FAILED ); # A ref to 3 is not a hashref. throws_ok( sub { assert_hashref( \3 ) }, $FAILED ); # [] is not a hashref throws_ok( sub { assert_hashref( [] ) }, $FAILED ); # sub {} is not a hashref my $coderef = sub {}; throws_ok( sub { assert_hashref( $coderef ) }, $FAILED ); # Foo->new->isa("HASH") returns true, so do we lives_ok( sub { assert_hashref( Foo->new ) } ); exit 0; Carp-Assert-More-2.9.0/t/assert_in.t0000644000101700007640000000307414733067030016353 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 12; use Carp::Assert::More; local $@; $@ = ''; # one element in arrayref eval { assert_in('one', [ 'one' ] ); }; is( $@, '' ); # separate string, two elements eval { my $string = 'B'; assert_in( $string, [ 'A', 'B' ] ); }; is( $@, '' ); # separate string and manual arrayref eval { my $string = 'delta'; my @array = ('alpha','beta','delta'); assert_in( $string, \@array ); }; is( $@, '' ); # separate string and arrayref eval { my $string = 'tres'; my $ref = [ 'uno', 'dos', 'tres', 'quatro' ]; assert_in( $string, $ref ); }; is( $@, '' ); # not found fails eval { assert_in( 'F', [ 'A', 'B', 'C', 'D', 'E' ] ); }; like( $@, qr/Assertion.*failed/ ); # undef in the list is OK eval { assert_in( 'C', [ 'A', 'B', 'C', undef ] ); }; is( $@, '' ); # undef is an OK value to match against the list. eval { assert_in( undef, [ 'A', 'B', 'C', undef ] ); }; is( $@, '' ); # refs in the list fails eval { assert_in( 'C', [ 'A', 'B', 'C', {} ] ); }; like( $@, qr/Assertion.*failed/ ); # undef string fails eval { assert_in( undef, [ 'fail' ] ); }; like( $@, qr/Assertion.*failed/ ); # empty array fails eval { assert_in( 'empty', [ ] ); }; like( $@, qr/Assertion.*failed/ ); # undef for the arrayref fails eval { my $string = 'zippo'; assert_in( $string, undef ); }; like( $@, qr/Assertion.*failed/ ); # A bad reference should also fail. eval { my $string = 'nil'; my $ref = \$string; assert_in( $string, $ref ); }; like( $@, qr/Assertion.*failed/ ); Carp-Assert-More-2.9.0/t/pod-coverage.t0000644000101700007640000000040014733067030016725 0ustar alesterispc#!perl use strict; use warnings; use Test::More; my $module = 'Test::Pod::Coverage 1.04'; if ( eval "use $module; 1;" ) { ## no critic (ProhibitStringyEval) all_pod_coverage_ok(); } else { plan skip_all => "$module required for testing POD"; } Carp-Assert-More-2.9.0/t/assert_context_list.t0000644000101700007640000000305614706773207020476 0ustar alesterispc#!perl use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; sub important_function { assert_context_list( 'must be list' ); return (2112, 5150, 90125); } local $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; like( $@, qr/\QAssertion (must be list) failed!/ ); # Keep the value in an array. eval { my @x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (must be list) failed!/ ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_list(); return 2112; } # Keep the value returned. eval { my $x = crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in list context) failed!/ ); # Keep the value in an array. eval { my @x = crucial_function(); }; is( $@, '' ); # Ignore the value returned. eval { crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in list context) failed!/ ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_list(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must be called in list context) failed!/ ); exit 0; Carp-Assert-More-2.9.0/t/assert_context_nonvoid.t0000644000101700007640000000267614733067030021174 0ustar alesterispc#!perl use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; sub important_function { assert_context_nonvoid( 'void is bad' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Keep the value in an array. eval { my @x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (void is bad) failed!/ ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_nonvoid(); return 2112; } # Keep the value returned. eval { my $x = crucial_function(); }; is( $@, '' ); # Keep the value in an array. eval { my @x = crucial_function(); }; is( $@, '' ); # Ignore the value returned. eval { crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must not be called in void context) failed!/ ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_nonvoid(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must not be called in void context) failed!/ ); exit 0; Carp-Assert-More-2.9.0/t/assert_lacks.t0000644000101700007640000000115214733067030017035 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use Test::Exception; my %foo = ( name => 'Andy Lester', phone => '578-3338', wango => undef, ); lives_ok( sub { assert_lacks( \%foo, 'Name' ) } ); throws_ok( sub { assert_lacks( \%foo, 'name' ); }, qr/Assert.+failed/ ); lives_ok( sub { assert_lacks( \%foo, [qw( Wango )] ); } ); lives_ok( sub { assert_lacks( \%foo, [qw( Wango Tango )] ); } ); throws_ok( sub { assert_lacks( \%foo, [qw( Wango Tango name )] ); }, qr/Assertion.+failed/ ); throws_ok( sub { assert_lacks( \%foo, [qw()] ); }, qr/Assertion.+failed/ ); Carp-Assert-More-2.9.0/t/assert_and.t0000644000101700007640000000065114733067030016505 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 5; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed/; AND: { lives_ok( sub { assert_and( 1, 'q' ) } ); throws_ok( sub { assert_and( 1, 0 ) }, $af ); throws_ok( sub { assert_and( 0, 1 ) }, $af ); throws_ok( sub { assert_and( 'q', undef ) }, $af ); throws_ok( sub { assert_and( '', 'whatever' ) }, $af ); } exit 0; Carp-Assert-More-2.9.0/t/assert_or.t0000644000101700007640000000062414733067030016363 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 5; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed/; OR: { lives_ok( sub { assert_or( 0, 'q' ) } ); lives_ok( sub { assert_or( 'q', 0 ) } ); lives_ok( sub { assert_or( 2112, 5150 ) } ); throws_ok( sub { assert_or( 0, 0 ) }, $af ); throws_ok( sub { assert_or( '', undef ) }, $af ); } exit 0; Carp-Assert-More-2.9.0/t/assert_nonzero_integer.t0000644000101700007640000000125214733067030021150 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, FAIL ], [ 0.4, FAIL ], [ -10, PASS ], [ "dog", FAIL ], [ "14.", FAIL ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_nonzero_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } Carp-Assert-More-2.9.0/t/test-coverage.t0000644000101700007640000000062014762221667017140 0ustar alesterispc#!perl use strict; use warnings; use Test::More tests => 52; use Carp::Assert::More; my @funcs = ( @Carp::Assert::More::EXPORT, @Carp::Assert::More::EXPORT_OK ); my %deduped; $deduped{$_}++ for @funcs; @funcs = sort keys %deduped; isnt( scalar @funcs, 0, 'There are no function names!' ); for my $func ( @funcs ) { my $filename = "t/$func.t"; ok( -e $filename, "$filename exists" ); } Carp-Assert-More-2.9.0/t/assert_nonref.t0000644000101700007640000000113214733067030017225 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 5; use Carp::Assert::More; local $@; $@ = ''; # 3 is nonref eval { assert_nonref( 3 ); }; is( $@, '' ); # 0 is nonref eval { assert_nonref( 0 ); }; is( $@, '' ); # '' is nonref eval { assert_nonref( 0 ); }; is( $@, '' ); # undef is not a reference, but it also fails by my rules eval { assert_nonref( undef ); }; like( $@, qr/Assertion.*failed/ ); # A reference is not a non-reference eval { my $scalar = "Blah blah"; my $ref = \$scalar; assert_nonref( $ref ); }; like( $@, qr/Assertion.*failed/ ); exit 0; Carp-Assert-More-2.9.0/t/pod.t0000644000101700007640000000036314733067030015144 0ustar alesterispc#!perl use strict; use warnings; use Test::More; my $module = 'Test::Pod 1.14'; if ( eval "use $module; 1;" ) { ## no critic (ProhibitStringyEval) all_pod_files_ok(); } else { plan skip_all => "$module required for testing POD"; } Carp-Assert-More-2.9.0/t/assert_empty.t0000644000101700007640000000331414733067030017100 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 14; use Test::Exception; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 0; my @cases = ( [ 0 => FAIL ], [ 'foo' => FAIL ], [ undef => FAIL ], [ {} => PASS ], [ [] => PASS ], [ {foo=>1} => FAIL ], [ [1,2,3] => FAIL ], ); for my $case ( @cases ) { my ($val,$expected_status) = @$case; eval { assert_empty( $val ) }; my $desc = 'Checking ' . ($val // 'undef'); if ( $expected_status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } NOT_AN_ARRAY: { throws_ok( sub { assert_nonempty( 27 ) }, qr/Assertion failed!.+Argument is not a hash or array\./sm ); } BLESSED_ARRAY: { my $array_object = bless( [], 'WackyPackage' ); lives_ok( sub { assert_empty( $array_object ) } ); push( @{$array_object}, 14 ); throws_ok( sub { assert_empty( $array_object, 'Flooble' ) }, qr/\QAssertion (Flooble) failed!\E.+Array contains 1 element\./sm ); push( @{$array_object}, 43, 'Q' ); throws_ok( sub { assert_empty( $array_object, 'Flooble' ) }, qr/\QAssertion (Flooble) failed!\E.+Array contains 3 elements\./sm ); } BLESSED_HASH: { my $hash_object = bless( {}, 'WackyPackage' ); lives_ok( sub { assert_empty( $hash_object ) } ); $hash_object->{foo} = 14; throws_ok( sub { assert_empty( $hash_object, 'Flargle' ) }, qr/\QAssertion (Flargle) failed!\E.+Hash contains 1 key\./sm ); $hash_object->{blu} = 28; $hash_object->{Q} = 47; throws_ok( sub { assert_empty( $hash_object, 'Flargle' ) }, qr/\QAssertion (Flargle) failed!\E.+Hash contains 3 keys\./sm ); } exit 0; Carp-Assert-More-2.9.0/t/assert_cmp.t0000644000101700007640000001663714733067030016535 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 113; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed!\n/; my $failed = qr/${af}Failed:/; NUMERIC_EQ: { lives_ok( sub { assert_cmp( 1, '==', 1 ) }, 'num == num' ); lives_ok( sub { assert_cmp( 2, '==', '2' ) }, 'num == str' ); lives_ok( sub { assert_cmp( '3', '==', 3 ) }, 'str == num' ); lives_ok( sub { assert_cmp( '4', '==', '4' ) }, 'str == str' ); lives_ok( sub { assert_cmp( 5, '==', 5.0 ) }, 'int == float' ); throws_ok( sub { assert_cmp( -1, '==', 1 ) }, qr/$failed -1 == 1/, 'num == num' ); throws_ok( sub { assert_cmp( -2, '==', '2' ) }, qr/$failed -2 == 2/, 'num == str' ); throws_ok( sub { assert_cmp( '-3', '==', 3 ) }, qr/$failed -3 == 3/, 'str == num' ); throws_ok( sub { assert_cmp( '-4', '==', '4' ) }, qr/$failed -4 == 4/, 'str == str' ); throws_ok( sub { assert_cmp( -5, '==', 5.0 ) }, qr/$failed -5 == 5/, 'int == float' ); } NUMERIC_NE: { lives_ok( sub { assert_cmp( -1, '!=', 1 ) }, 'num != num' ); lives_ok( sub { assert_cmp( -2, '!=', '2' ) }, 'num != str' ); lives_ok( sub { assert_cmp( '-3', '!=', 3 ) }, 'str != num' ); lives_ok( sub { assert_cmp( '-4', '!=', '4' ) }, 'str != str' ); lives_ok( sub { assert_cmp( -5, '!=', 5.0 ) }, 'int != float' ); throws_ok( sub { assert_cmp( 1, '!=', 1 ) }, qr/$failed 1 != 1/, 'num != num' ); throws_ok( sub { assert_cmp( 2, '!=', '2' ) }, qr/$failed 2 != 2/, 'num != str' ); throws_ok( sub { assert_cmp( '3', '!=', 3 ) }, qr/$failed 3 != 3/, 'str != num' ); throws_ok( sub { assert_cmp( '4', '!=', '4' ) }, qr/$failed 4 != 4/, 'str != str' ); throws_ok( sub { assert_cmp( 5, '!=', 5.0 ) }, qr/$failed 5 != 5/, 'int != float' ); } NUMERIC_LT: { lives_ok( sub { assert_cmp( 1, '<', 2 ) }, 'num < num' ); lives_ok( sub { assert_cmp( 2, '<', '3' ) }, 'num < str' ); lives_ok( sub { assert_cmp( '3', '<', 4 ) }, 'str < num' ); lives_ok( sub { assert_cmp( '4', '<', '5' ) }, 'str < str' ); lives_ok( sub { assert_cmp( 5, '<', 6.0 ) }, 'int < float' ); lives_ok( sub { assert_cmp( 6.0, '<', 7 ) }, 'float < int' ); lives_ok( sub { assert_cmp( 7.0, '<', 8.0 ) }, 'float < float' ); throws_ok( sub { assert_cmp( 1, '<', 1 ) }, qr/$failed 1 < 1/, 'num < num' ); throws_ok( sub { assert_cmp( 2, '<', '2' ) }, qr/$failed 2 < 2/, 'num < str' ); throws_ok( sub { assert_cmp( '3', '<', 3 ) }, qr/$failed 3 < 3/, 'str < num' ); throws_ok( sub { assert_cmp( '4', '<', '4' ) }, qr/$failed 4 < 4/, 'str < str' ); throws_ok( sub { assert_cmp( 5, '<', 5.0 ) }, qr/$failed 5 < 5/, 'int < float' ); throws_ok( sub { assert_cmp( 6.0, '<', 6 ) }, qr/$failed 6 < 6/, 'float < int' ); throws_ok( sub { assert_cmp( 7.0, '<', 7.0 ) }, qr/$failed 7 < 7/, 'float < float' ); } NUMERIC_LE: { lives_ok( sub { assert_cmp( 1, '<=', 2 ) }, 'num <= num' ); lives_ok( sub { assert_cmp( 2, '<=', '3' ) }, 'num <= str' ); lives_ok( sub { assert_cmp( '3', '<=', 4 ) }, 'str <= num' ); lives_ok( sub { assert_cmp( '4', '<=', '5' ) }, 'str <= str' ); lives_ok( sub { assert_cmp( 5, '<=', 6.0 ) }, 'int <= float' ); lives_ok( sub { assert_cmp( 6.0, '<=', 7 ) }, 'float <= int' ); lives_ok( sub { assert_cmp( 7.0, '<=', 8.0 ) }, 'float <= float' ); throws_ok( sub { assert_cmp( 1, '<=', 0 ) }, qr/$failed 1 <= 0/, 'num <= num' ); throws_ok( sub { assert_cmp( 2, '<=', '1' ) }, qr/$failed 2 <= 1/, 'num <= str' ); throws_ok( sub { assert_cmp( '3', '<=', 2 ) }, qr/$failed 3 <= 2/, 'str <= num' ); throws_ok( sub { assert_cmp( '4', '<=', '3' ) }, qr/$failed 4 <= 3/, 'str <= str' ); throws_ok( sub { assert_cmp( 5, '<=', 4.0 ) }, qr/$failed 5 <= 4/, 'int <= float' ); throws_ok( sub { assert_cmp( 6.0, '<=', 5 ) }, qr/$failed 6 <= 5/, 'float <= int' ); throws_ok( sub { assert_cmp( 7.0, '<=', 6.0 ) }, qr/$failed 7 <= 6/, 'float <= float' ); } NUMERIC_GT: { lives_ok( sub { assert_cmp( 1, '>', 0 ) }, 'num > num' ); lives_ok( sub { assert_cmp( 2, '>', '1' ) }, 'num > str' ); lives_ok( sub { assert_cmp( '3', '>', 2 ) }, 'str > num' ); lives_ok( sub { assert_cmp( '4', '>', '3' ) }, 'str > str' ); lives_ok( sub { assert_cmp( 5, '>', 4.0 ) }, 'int > float' ); lives_ok( sub { assert_cmp( 6.0, '>', 5 ) }, 'float > int' ); lives_ok( sub { assert_cmp( 7.0, '>', 6.0 ) }, 'float > float' ); throws_ok( sub { assert_cmp( 1, '>', 1 ) }, qr/$failed 1 > 1/, 'num > num' ); throws_ok( sub { assert_cmp( 2, '>', '2' ) }, qr/$failed 2 > 2/, 'num > str' ); throws_ok( sub { assert_cmp( '3', '>', 3 ) }, qr/$failed 3 > 3/, 'str > num' ); throws_ok( sub { assert_cmp( '4', '>', '4' ) }, qr/$failed 4 > 4/, 'str > str' ); throws_ok( sub { assert_cmp( 5, '>', 5.0 ) }, qr/$failed 5 > 5/, 'int > float' ); throws_ok( sub { assert_cmp( 6.0, '>', 6 ) }, qr/$failed 6 > 6/, 'float > int' ); throws_ok( sub { assert_cmp( 7.0, '>', 7.0 ) }, qr/$failed 7 > 7/, 'float > float' ); } NUMERIC_GE: { lives_ok( sub { assert_cmp( 1, '>=', 1 ) }, 'num >= num' ); lives_ok( sub { assert_cmp( 2, '>=', '2' ) }, 'num >= str' ); lives_ok( sub { assert_cmp( '3', '>=', 3 ) }, 'str >= num' ); lives_ok( sub { assert_cmp( '4', '>=', '4' ) }, 'str >= str' ); lives_ok( sub { assert_cmp( 5, '>=', 5.0 ) }, 'int >= float' ); lives_ok( sub { assert_cmp( 6.0, '>=', 6 ) }, 'float >= int' ); lives_ok( sub { assert_cmp( 7.0, '>=', 7.0 ) }, 'float >= float' ); throws_ok( sub { assert_cmp( 0, '>=', 1 ) }, qr/$failed 0 >= 1/, 'num >= num' ); throws_ok( sub { assert_cmp( 1, '>=', '2' ) }, qr/$failed 1 >= 2/, 'num >= str' ); throws_ok( sub { assert_cmp( '2', '>=', 3 ) }, qr/$failed 2 >= 3/, 'str >= num' ); throws_ok( sub { assert_cmp( '3', '>=', '4' ) }, qr/$failed 3 >= 4/, 'str >= str' ); throws_ok( sub { assert_cmp( 4, '>=', 5.0 ) }, qr/$failed 4 >= 5/, 'int >= float' ); throws_ok( sub { assert_cmp( 5.0, '>=', 6 ) }, qr/$failed 5 >= 6/, 'float >= int' ); throws_ok( sub { assert_cmp( 6.0, '>=', 7.0 ) }, qr/$failed 6 >= 7/, 'float >= float' ); } BAD_NUMBERS: { my @operators = qw( == != > >= < <= ); for my $op ( @operators ) { throws_ok( sub { assert_cmp( 12, $op, undef ) }, qr/$failed 12 $op undef/, "num $op undef" ); throws_ok( sub { assert_cmp( undef, $op, 14 ) }, qr/$failed undef $op 14/, "undef $op num" ); throws_ok( sub { assert_cmp( undef, $op, undef) }, qr/$failed undef $op undef/, "undef $op undef" ); } } STRINGS: { lives_ok( sub { assert_cmp( 'a', 'lt', 'b' ) }, 'lt' ); lives_ok( sub { assert_cmp( 'a', 'le', 'a' ) }, 'le' ); lives_ok( sub { assert_cmp( 'b', 'gt', 'a' ) }, 'gt' ); lives_ok( sub { assert_cmp( 'a', 'ge', 'a' ) }, 'ge' ); throws_ok( sub { assert_cmp( 'a', 'lt', 'a' ) }, qr/$failed a lt a/ ); throws_ok( sub { assert_cmp( 'b', 'le', 'a' ) }, qr/$failed b le a/ ); throws_ok( sub { assert_cmp( 'a', 'gt', 'a' ) }, qr/$failed a gt a/ ); throws_ok( sub { assert_cmp( 'a', 'ge', 'b' ) }, qr/$failed a ge b/ ); } BAD_OPERATOR: { for my $op ( qw( xx eq ne lte gte LT LE GT GE ), undef ) { my $dispop = $op ? qq{"$op"} : ''; throws_ok( sub { assert_cmp( 3, $op, 3 ) }, qr/${af}Invalid operator $dispop/ ); } } BAD_VALUES: { throws_ok( sub { assert_cmp( 9, '>', undef ) }, qr/$failed 9 > undef/ ); } exit 0; Carp-Assert-More-2.9.0/t/assert_arrayref_nonempty_of.t0000644000101700007640000000271014762221516022174 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [@_], $class; } package main; use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; MAIN: { # {} is not an arrayref. throws_ok( sub { assert_arrayref_nonempty_of( {}, 'Foo' ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref_nonempty_of( $ref, 'Foo' ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref_nonempty_of( 3, 'Foo' ) }, $FAILED ); # [] is a nonempty arrayref. lives_ok( sub { assert_arrayref_nonempty_of( [ Foo->new ], 'Foo' ) } ); # [] is an empty arrayref. throws_ok( sub { assert_arrayref_nonempty_of( [], 'Foo' ) }, $FAILED ); my @empty_ary = (); throws_ok( sub { assert_arrayref_nonempty_of( \@empty_ary, 'Foo' ) }, $FAILED ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref_nonempty_of( $coderef, 'Foo' ) }, $FAILED ); } WHICH_ELEMENT: { lives_ok( sub { assert_arrayref_nonempty_of( [ Foo->new, Foo->new ], 'Foo' ) } ); # Check for both parts of the message. throws_ok( sub { assert_arrayref_nonempty_of( [ Foo->new, Foo->new, {} ], 'Foo' ) }, $FAILED ); throws_ok( sub { assert_arrayref_nonempty_of( [ Foo->new, Foo->new, {} ], 'Foo' ) }, qr/Element #2/ ); } exit 0; Carp-Assert-More-2.9.0/t/assert_aoh.t0000644000101700007640000000227214733067030016513 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [ { vh => 5150, r => 2112 }, { foo => 'bar' } ], $class } package main; use warnings; use strict; use Test::More tests => 8; use Carp::Assert::More; local $@; $@ = ''; # {} is not a arrayref eval { assert_aoh( {} ); }; like( $@, qr/Assertion.*failed/ ); # A hashref is not a arrayref. my $ref = { foo => 'foo', bar => 'bar' }; eval { assert_aoh( $ref ); }; like( $@, qr/Assertion.*failed/ ); # 3 is not a arrayref eval { assert_aoh( 3 ); }; like( $@, qr/Assertion.*failed/ ); # [] is a arrayref eval { assert_aoh( [] ); }; is( $@, '' ); # Arrayref is OK, but it doesn't contain hashrefs. # a ref to a list with stuff in it is a arrayref my @ary = ('foo', 'bar', 'baaz'); eval { assert_aoh( \@ary ); }; like( $@, qr/Assertion.*failed/ ); # Everything in the arrayref has to be a hash. @ary = ( { foo => 'bar' }, 'scalar' ); eval { assert_aoh( \@ary ); }; like( $@, qr/Assertion.*failed/ ); # sub {} is not a arrayref eval { assert_aoh( sub {} ); }; like( $@, qr/Assertion.*failed/ ); # The return from a constructor is an AOH so it should pass. eval { assert_aoh( Foo->new ); }; is( $@, '' ); exit 0; Carp-Assert-More-2.9.0/t/assert_like.t0000644000101700007640000000147514733067030016674 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 7; use Test::Exception; use Carp::Assert::More; lives_ok( sub { assert_like('unlikely', qr/like/ ); } ); lives_ok( sub { assert_like( 'tempest', qr/te.*st/ ); } ); lives_ok( sub { assert_like( 'quality inn', qr/qu.*inn/ ); } ); throws_ok( sub { assert_like( 'passing', qr/fa.*il/, 'Flargle' ); }, qr/\QAssertion (Flargle) failed!/ ); throws_ok( sub { assert_like( undef, qr/anything/, 'Bongo' ); }, qr/\QAssertion (Bongo) failed!/, 'undef string always fails' ); throws_ok( sub { assert_like( 'Blah blah', undef, 'Bingo' ); }, qr/\QAssertion (Bingo) failed!/, 'undef regex always fails' ); throws_ok( sub { my $string = 'Blah blah'; my $ref = \$string; assert_like( $string, $ref, 'Dingo' ); }, qr/\QAssertion (Dingo) failed/, 'bad reference fails' ); Carp-Assert-More-2.9.0/t/assert_all_keys_in.t0000644000101700007640000000350714733067030020237 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 9; use Carp::Assert::More; use Test::Exception; my $af = qr/Assertion failed!\n/; MAIN: { my $monolith = { depth => 1, width => 4, height => 9, }; my $shaq = { firstname => 'Shaquille', lastname => 'O\'Neal', height => 85, }; my @object_keys = keys %{$monolith}; my @person_keys = keys %{$shaq}; lives_ok( sub { assert_all_keys_in( $monolith, \@object_keys ) }, 'Monolith object has valid keys' ); lives_ok( sub { assert_all_keys_in( $shaq, \@person_keys ) }, 'Shaq object has valid keys' ); throws_ok( sub { assert_all_keys_in( $monolith, \@person_keys ) }, qr/${af}Key "(depth|width)" is not a valid key\./sm, 'Monolith fails on person keys' ); throws_ok( sub { assert_all_keys_in( $monolith, [] ) }, qr/${af}Key "(depth|width|height)" is not a valid key\./sm, 'Monolith fails on empty list of keys' ); throws_ok( sub { assert_all_keys_in( $monolith, {} ) }, qr/${af}Argument for array of keys is not an arrayref\./sm, 'Fails on a non-array list of keys' ); throws_ok( sub { assert_all_keys_in( [], \@object_keys ) }, qr/${af}Argument for hash is not a hashref\./sm, 'Fails on a non-hashref hash' ); lives_ok( sub { assert_all_keys_in( {}, [] ) }, 'Empty hash and empty keys' ); # Check that all keys get reported. my @expected = ( qr/Key "depth" is not a valid key/, qr/Key "width" is not a valid key/, ); for my $expected ( @expected ) { throws_ok( sub { assert_all_keys_in( $monolith, \@person_keys ) }, qr/${af}.*$expected/sm, "Message found: $expected" ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_nonnegative_integer.t0000644000101700007640000000126714733067030022001 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, PASS ], [ 0.4, FAIL ], [ -10, FAIL ], [ "dog", FAIL ], [ "14.", FAIL ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_nonnegative_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_numeric_between.t0000644000101700007640000000115514733067030021116 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 7; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed/; MAIN: { lives_ok( sub { assert_numeric_between( 5, 1, 10 ) } ); lives_ok( sub { assert_numeric_between( -5, -10, -1 ) } ); lives_ok( sub { assert_numeric_between( 57, 1, 100 ) } ); lives_ok( sub { assert_numeric_between( 3.14, 1, 10 ) }, $af ); throws_ok( sub { assert_numeric_between( -5, 1, 10 ) }, $af ); throws_ok( sub { assert_numeric_between( 'x', 1, 10 ) }, $af ); throws_ok( sub { assert_numeric_between( undef, 1, 10 ) }, $af ); } exit 0; Carp-Assert-More-2.9.0/t/assert_negative_integer.t0000644000101700007640000000131414733067030021257 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 11; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, FAIL ], [ 0, FAIL ], [ 0.4, FAIL ], [ -10, PASS ], [ -97.9, FAIL ], [ "dog", FAIL ], [ "14.", FAIL ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_negative_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_hashref_nonempty.t0000644000101700007640000000224514733067030021315 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless {@_}, $class; } package main; use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; # {} is a hashref lives_ok( sub { assert_hashref_nonempty( { foo => 'bar' } ) } ); throws_ok( sub { assert_hashref_nonempty( {} ) }, $FAILED ); # A ref to a hash with stuff in it is a hashref. my %hash = ( foo => 'foo', bar => 'bar' ); lives_ok( sub { assert_hashref_nonempty( \%hash ) } ); my %hash_empty; throws_ok( sub { assert_hashref_nonempty( \%hash_empty ) }, $FAILED ); # 3 is not a hashref. throws_ok( sub { assert_hashref_nonempty( 3 ) }, $FAILED ); # A ref to 3 is not a hashref. throws_ok( sub { assert_hashref_nonempty( \3 ) }, $FAILED ); # [] is not a hashref throws_ok( sub { assert_hashref_nonempty( [] ) }, $FAILED ); # sub {} is not a hashref my $coderef = sub {}; throws_ok( sub { assert_hashref_nonempty( $coderef ) }, $FAILED ); # Foo->new->isa("HASH") returns true, so do we throws_ok( sub { assert_hashref_nonempty( Foo->new ) }, $FAILED ); lives_ok( sub { assert_hashref_nonempty( Foo->new( foo => 'bar' ) ) } ); exit 0; Carp-Assert-More-2.9.0/t/assert_negative.t0000644000101700007640000000124414733067030017544 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, FAIL ], [ 0, FAIL ], [ 0.4, FAIL ], [ -10, PASS ], [ "dog", FAIL ], [ "14.", FAIL ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_negative( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } Carp-Assert-More-2.9.0/t/assert_integer_between.t0000644000101700007640000000115614733067030021112 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 7; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed/; MAIN: { lives_ok( sub { assert_integer_between( 5, 1, 10 ) } ); lives_ok( sub { assert_integer_between( -5, -10, -1 ) } ); lives_ok( sub { assert_integer_between( 57, 1, 100 ) } ); throws_ok( sub { assert_integer_between( 3.14, 1, 10 ) }, $af ); throws_ok( sub { assert_integer_between( -5, 1, 10 ) }, $af ); throws_ok( sub { assert_integer_between( 'x', 1, 10 ) }, $af ); throws_ok( sub { assert_integer_between( undef, 1, 10 ) }, $af ); } exit 0; Carp-Assert-More-2.9.0/t/assert_listref.t0000644000101700007640000000170114733067030017410 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [@_], $class; } package main; use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; local $@; $@ = ''; # {} is not a listref eval { assert_listref( {} ); }; like( $@, qr/Assertion.*failed/ ); # a ref to a hash with stuff in it is not a listref my $ref = { foo => 'foo', bar => 'bar' }; eval { assert_listref( $ref ); }; like( $@, qr/Assertion.*failed/ ); # 3 is not a listref eval { assert_listref( 3 ); }; like( $@, qr/Assertion.*failed/ ); # [] is a listref eval { assert_listref( [] ); }; is( $@, '' ); # a ref to a list with stuff in it is a listref my @ary = ('foo', 'bar', 'baaz'); eval { assert_listref( \@ary ); }; is( $@, '' ); # sub {} is not a listref eval { assert_listref( sub {} ); }; like( $@, qr/Assertion.*failed/ ); # Foo->new->isa("ARRAY") returns true, so do we eval { assert_listref( Foo->new ); }; is( $@, '' ); Carp-Assert-More-2.9.0/t/assert.t0000644000101700007640000000106014733067030015656 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Test::Exception; use Carp::Assert::More; MAIN: { my @false_values = ( '', 0, undef, ); my @true_values = ( 1, 14, '00', ' ', [], {}, 'foo', ); for my $val ( @false_values ) { throws_ok( sub { assert( $val ) }, qr/^Assertion failed/, 'Val: ' . ($val // 'undef') ); } for my $val ( @true_values ) { lives_ok( sub { assert( $val ) }, "Val: $val" ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_exists.t0000644000101700007640000000211314733067030017255 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; my %foo = ( name => 'Andy Lester', phone => '578-3338', wango => undef, ); eval { assert_exists( \%foo, 'name' ); }; is( $@, '' ); eval { assert_exists( \%foo, 'wango' ); }; is( $@, '' ); eval { assert_exists( \%foo, 'Nonexistent' ); }; like( $@, qr/Assert.+failed/ ); # Fails if list of keys to check is undef. eval { assert_exists( \%foo, undef ); }; like( $@, qr/Assert.+failed/ ); # Fails if list of keys to check is not an array. eval { assert_exists( \%foo, {} ); }; like( $@, qr/Assert.+failed/ ); # Fails with empty list of keys to check. eval { assert_exists( \%foo, [] ); }; like( $@, qr/Assert.+failed/ ); eval { assert_exists( \%foo, [qw( name )] ); }; is( $@, '' ); eval { assert_exists( \%foo, [qw( name social-security-number )] ); }; like( $@, qr/Assertion.+failed/ ); eval { assert_exists( \%foo, [qw( name phone )] ); }; is( $@, '' ); eval { assert_exists( \%foo, ['name','Nonexistent'] ); }; like( $@, qr/Assert.+failed/ ); Carp-Assert-More-2.9.0/t/assert_datetime.t0000644000101700007640000000134214733067030017535 0ustar alesterispc#!perl use warnings; use strict; use Test::More; use Carp::Assert::More; my $module = 'DateTime'; if ( !eval "use $module; 1;" ) { ## no critic (ProhibitStringyEval) plan skip_all => "$module required for testing assert_datetime()"; } plan tests => 11; my %bad = ( 'hashref' => {}, 'undef' => undef, 'integer' => 17, 'coderef' => \&like, 'date string' => '1941-12-07', ); while ( my ($desc,$val) = each %bad ) { my $rc = eval { assert_datetime( $val ); 1 }; is( $rc, undef, "assertion did not pass: $desc" ); like( $@, qr/Assertion.+failed/, "Error message matches: $desc" ); } my $dt = DateTime->now; assert_datetime( $dt ); pass( 'Got past a valid assertion' ); exit 0; Carp-Assert-More-2.9.0/t/assert_isa_in.t0000644000101700007640000000366114733067030017211 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 20; use Carp::Assert::More; use Test::Exception; my $rc = eval 'assert_isa_in(undef)'; is( $rc, undef, 'Fails the eval' ); like( $@, qr/Not enough arguments for Carp::Assert::More::assert_isa_in/, 'Prototype requires two arguments' ); dies_ok { assert_isa_in(undef, undef) } 'Dies with one undef argument'; dies_ok { assert_isa_in(bless({}, 'x'), [] ) } 'No types passed in'; dies_ok { assert_isa_in('z', []) } 'List of empty types does not allow you to pass non-objects'; lives_ok { assert_isa_in( bless({}, 'x'), [ 'x' ] ) } 'One out of one'; dies_ok { assert_isa_in( bless({}, 'x'), [ 'y' ] ) } 'Zero out of one'; lives_ok { assert_isa_in( bless({}, 'x'), [ 'y', 'x' ] ) } 'One out of two'; @y::ISA = ( 'x' ); my $x = bless {}, 'y'; isa_ok( $x, 'y', 'Verifying our assumptions' ); lives_ok { assert_isa_in( bless({}, 'y'), [ 'y' ] ) } 'Matches child class'; lives_ok { assert_isa_in( bless({}, 'y'), [ 'x' ] ) } 'Matches base class'; dies_ok { assert_isa_in( bless({}, 'x'), [ 'y' ] ) } 'Parent does not match child'; ASSERT_ISA_IN: { package a; sub foo {} package main; my $aa = bless {}, 'a'; package b; sub foo {} package main; my $bb = bless {}, 'b'; package c; sub foo {} package main; my $cc = bless {}, 'c'; package d; use base 'a'; use base 'b'; use base 'c'; package main; my $dd = bless {}, 'd'; lives_ok( sub { assert_isa_in($aa, ['a']) }, 'Basic a' ); lives_ok( sub { assert_isa_in($aa, ['a', 'b', 'c']) }, 'Basic a, b, c' ); foreach my $class ( ref $aa, ref $bb, ref $cc ) { lives_ok( sub { assert_isa_in($dd, [$class]) }, "Inheritance for $class" ); } my $failure_regex = qr/ssertion failed/; foreach my $class ( ref $aa, ref $bb, ref $cc ) { throws_ok( sub { assert_isa_in($class, ['d']) }, $failure_regex, "No backwards-inheritance for $class" ); } }; exit 0; Carp-Assert-More-2.9.0/t/assert_arrayref_nonempty.t0000644000101700007640000000252214733067030021506 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [@_], $class; } package main; use warnings; use strict; use Test::More tests => 11; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; # {} is not an arrayref. throws_ok( sub { assert_arrayref_nonempty( {} ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref_nonempty( $ref ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref_nonempty( 3 ) }, $FAILED ); # [] is a nonempty arrayref. lives_ok( sub { assert_arrayref_nonempty( [ 3 ] ) } ); lives_ok( sub { assert_arrayref_nonempty( [ undef ] ) } ); # [] is an empty arrayref. throws_ok( sub { assert_arrayref_nonempty( [] ) }, $FAILED ); # A ref to a list with stuff in it is an arrayref. my @ary = ('foo', 'bar', 'baaz'); lives_ok( sub { assert_arrayref_nonempty( \@ary ) } ); my @empty_ary = (); throws_ok( sub { assert_arrayref_nonempty( \@empty_ary ) }, $FAILED ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref_nonempty( $coderef ) }, $FAILED ); # Foo->new->isa("ARRAY") returns true, but check emptiness. lives_ok( sub { assert_arrayref_nonempty( Foo->new( 14 ) ) } ); throws_ok( sub { assert_arrayref_nonempty( Foo->new ) }, $FAILED ); exit 0; Carp-Assert-More-2.9.0/t/assert_nonnegative.t0000644000101700007640000000124614733067030020261 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, PASS ], [ 0.4, PASS ], [ -10, FAIL ], [ 'dog', FAIL ], [ "14.", PASS ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_nonnegative( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } Carp-Assert-More-2.9.0/t/assert_arrayref.t0000644000101700007640000000165514733067030017563 0ustar alesterispc#!perl package Foo; sub new { my $class = shift; return bless [@_], $class; } package main; use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; # {} is not an arrayref. throws_ok( sub { assert_arrayref( {} ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref( $ref ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref( 3 ) }, $FAILED ); # [] is an arrayref. lives_ok( sub { [] } ); # A ref to a list with stuff in it is an arrayref. my @ary = ('foo', 'bar', 'baaz'); lives_ok( sub { assert_arrayref( \@ary ) } ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref( $coderef ) }, $FAILED ); # Foo->new->isa("ARRAY") returns true, so do we lives_ok( sub { assert_arrayref( Foo->new ) } ); exit 0; Carp-Assert-More-2.9.0/t/assert_xor.t0000644000101700007640000000054314733067030016553 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 4; use Test::Exception; use Carp::Assert::More; my $af = qr/Assertion failed/; XOR: { lives_ok( sub { assert_xor( 0, 'q' ) } ); lives_ok( sub { assert_xor( 'q', 0 ) } ); throws_ok( sub { assert_xor( 0, 0 ) }, $af ); throws_ok( sub { assert_xor( 1, 1 ) }, $af ); } exit 0; Carp-Assert-More-2.9.0/t/assert_undefined.t0000644000101700007640000000076314733067030017710 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 4; use Carp::Assert::More; use Test::Exception; throws_ok( sub { assert_undefined( 3, 'Fleegle' ); }, qr/\QAssertion (Fleegle) failed!/, '3 is defined' ); throws_ok( sub { assert_undefined( 0, 'Drooper' ); }, qr/\QAssertion (Drooper) failed!/, '0 is defined' ); throws_ok( sub { assert_undefined( '', 'Snork' ); }, qr/\QAssertion (Snork) failed!/, 'blank is defined' ); lives_ok( sub { assert_undefined( undef ); }, '0 is undefined' ); Carp-Assert-More-2.9.0/t/assert_nonblank.t0000644000101700007640000000165214733067030017547 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 7; use Test::Exception; use Carp::Assert::More; lives_ok( sub { assert_nonblank( 3 ) } ); lives_ok( sub { assert_nonblank( 0 ) } ); throws_ok( sub { assert_nonblank( '' ) }, qr/Assertion failed!.+Value is blank/sm, q{'' is blank, with no message} ); throws_ok( sub { assert_nonblank( '', 'flooble' ) }, qr/\QAssertion (flooble) failed!\E.+Value is blank/sm, q{'' is blank, with message} ); throws_ok( sub { assert_nonblank( undef ) }, qr/Assertion failed!.+Value is undef/sm, q{undef is blank, with no message} ); throws_ok( sub { assert_nonblank( undef, 'bargle' ) }, qr/\QAssertion (bargle) failed!\E.+Value is undef/sm, q{undef is blank, with message} ); throws_ok( sub { my $scalar = "Blah blah"; my $ref = \$scalar; assert_nonblank( $ref, 'wango' ); }, qr/\QAssertion (wango) failed!\E.+Value is a reference to SCALAR/ms, 'Testing scalar ref' ); exit 0; Carp-Assert-More-2.9.0/t/assert_regex.t0000644000101700007640000000127514736024235017063 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 15; use Carp::Assert::More; use Test::Exception; my @good = ( qr//, qr/Foo/, qr/slash i/i, qr/slash m/m, qr/slash s/s, qr/slash x/x, ); my @bad = ( undef, 14, '', '//', '/Foo/', [], {}, \99, \*STDIN, ); for my $good ( @good ) { lives_ok( sub { assert_regex( $good, "$good is good" ) }, "$good passes assertion" ); } for my $bad ( @bad ) { my $disp = $bad; $disp = '' unless defined $disp; throws_ok( sub { assert_regex( $bad, "$disp is bad" ) }, qr/\Q$disp is bad/, "$disp fails assertion" ); } exit 0; Carp-Assert-More-2.9.0/t/assert_context_scalar.t0000644000101700007640000000324114733067030020752 0ustar alesterispc#!perl use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; # First we test the assertions with an explicit message passed. sub important_function { assert_context_scalar( 'non-scalar context is bad' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (non-scalar context is bad) failed!/ ); # Call in list context. eval { my @x = important_function(); }; like( $@, qr/\QAssertion (non-scalar context is bad) failed!/ ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_scalar(); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = crucial_function(); }; is( $@, '' ); # Ignore the value returned. eval { crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in scalar context) failed!/ ); # Call in list context. eval { my @x = crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in scalar context) failed!/ ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_scalar(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must be called in scalar context) failed!/ ); exit 0; Carp-Assert-More-2.9.0/t/assert_unlike.t0000644000101700007640000000172114733067030017231 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 7; use Test::Exception; use Carp::Assert::More; throws_ok( sub { assert_unlike( 'unlikely', qr/like/, 'Wango' ); }, qr/\QAssertion (Wango) failed!/, 'Testing simple matching' ); throws_ok( sub { assert_unlike( 'tempest', qr/te.*st/, 'Tango' ); }, qr/\QAssertion (Tango) failed!/, 'Testing simple matching' ); lives_ok( sub { assert_unlike( 'passing', qr/fa.*il/, 'Flargle' ); }, 'Simple non-matching' ); lives_ok( sub { assert_unlike( undef, qr/anything/ ); }, 'undef string is always unlike' ); throws_ok( sub { assert_unlike( 'Blah blah', undef, 'Bingo' ); }, qr/\QAssertion (Bingo) failed!/, 'undef regex always fails' ); throws_ok( sub { my $string = 'Blah blah'; my $ref = \$string; assert_unlike( $string, $ref, 'Dingo' ); }, qr/\QAssertion (Dingo) failed/, 'bad reference fails' ); lives_ok( sub { assert_unlike( undef, qr/something/, 'Monkey' ) }, 'undef string always passes' ); exit 0; Carp-Assert-More-2.9.0/t/assert_context_void.t0000644000101700007640000000304114706773207020456 0ustar alesterispc#!perl use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; sub important_function { assert_context_void( 'must be void' ); return; } local $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; like( $@, qr/\QAssertion (must be void) failed!/ ); # Keep the value in an array. eval { my @x = important_function(); }; like( $@, qr/\QAssertion (must be void) failed!/ ); # Ignore the value returned. eval { important_function(); }; is( $@, '' ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_void(); return 2112; } # Keep the value returned. eval { my $x = crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in void context) failed!/ ); # Keep the value in an array. eval { my @x = crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in void context) failed!/ ); # Ignore the value returned. eval { crucial_function(); }; is( $@, '' ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_void(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { my $x = Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must be called in void context) failed!/ ); exit 0; Carp-Assert-More-2.9.0/t/assert_positive.t0000644000101700007640000000125614733067030017607 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, FAIL ], [ 0.4, PASS ], [ -10, FAIL ], [ 'dog', FAIL ], [ '14.', PASS ], ); for my $case ( @cases ) { my ($val,$status) = @{$case}; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_positive( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_isa.t0000644000101700007640000000157514733067030016525 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 5; use Carp::Assert::More; use IO::File; # just for creating objects local $@; $@ = ''; eval { my $fh = new IO::File; assert_isa( $fh, 'IO::File', 'Created an IO::File object' ); assert_isa( $fh, 'GLOB', 'Created an IO::File object, which is a GLOB' ); }; is( $@, '' ); eval { # integer is not an object my $random = 2112; assert_isa( $random, 'IO::File', 'Created an IO::File object' ); }; like( $@, qr/Assertion.*failed/ ); eval { # undef is not an object my $random = undef; assert_isa( $random, 'IO::File', 'Created an IO::File object' ); }; like( $@, qr/Assertion.*failed/ ); eval { my @array; assert_isa( \@array, 'HASH', 'An array is not a hash' ); }; like( $@, qr/Assertion.*failed/ ); eval { my %hash; assert_isa( \%hash, 'HASH', 'Created a hash' ); }; is( $@, '' ); Carp-Assert-More-2.9.0/t/assert_defined.t0000644000101700007640000000065214733067030017342 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 4; use Carp::Assert::More; use Test::Exception; lives_ok( sub { assert_defined( 3 ); }, '3 is defined' ); lives_ok( sub { assert_defined( 0 ); }, '0 is false but defined' ); lives_ok( sub { assert_defined( '' ); }, 'blank is false but defined' ); throws_ok( sub { assert_defined( undef, 'Flargle' ); }, qr/\QAssertion (Flargle) failed!/, 'undef is not defined' ); Carp-Assert-More-2.9.0/t/assert_keys_are.t0000644000101700007640000000462714733067030017554 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 15; use Carp::Assert::More; use Test::Exception; my $af = qr/Assertion failed!\n/; my $failed = qr/${af}Failed:/; BASICS: { my $monolith = { depth => 1, width => 4, height => 9, }; my $shaq = { firstname => 'Shaquille', lastname => 'O\'Neal', height => 85, }; my @object_keys = qw( height width depth ); my @person_keys = qw( firstname lastname height ); lives_ok( sub { assert_keys_are( $monolith, \@object_keys ) }, 'Monolith object has valid keys' ); lives_ok( sub { assert_keys_are( $shaq, \@person_keys ) }, 'Shaq object has valid keys' ); lives_ok( sub { assert_keys_are( {}, [] ) }, 'Empty hash + empty keys works fine' ); throws_ok( sub { assert_keys_are( $monolith, \@person_keys ) }, qr/$af/, 'Monolith fails on person keys' ); throws_ok( sub { assert_keys_are( $monolith, [@object_keys[0..1]] ) }, qr/$af/, 'Hash has too many keys' ); throws_ok( sub { assert_keys_are( $monolith, [@object_keys, 'wavelength'] ) }, qr/$af/, 'Hash has one key too many' ); throws_ok( sub { assert_keys_are( $monolith, [] ) }, qr/${af}Key "(depth|height|width)" is not a valid key\./sm, 'Empty key list fails for non-empty object' ); throws_ok( sub { assert_keys_are( {}, \@object_keys ) }, qr/${af}Key "(depth|height|width)" is not in the hash\./sm, 'Empty hash fails for non-empty key list' ); throws_ok( sub { assert_keys_are( $monolith, {} ) }, qr/${af}Argument for array of keys is not an arrayref\./sm, 'Fails on a non-array list of keys' ); throws_ok( sub { assert_keys_are( [], \@object_keys ) }, qr/${af}Argument for hash is not a hashref\./sm, 'Fails on a non-hashref hash' ); my @keys = qw( a b c height ); my @expected = ( qr/Key "depth" is not a valid key/, qr/Key "width" is not a valid key/, qr/Key "a" is not in the hash/, qr/Key "b" is not in the hash/, qr/Key "c" is not in the hash/, ); for my $expected ( @expected ) { throws_ok( sub { assert_keys_are( $monolith, \@keys ) }, qr/${af}.*$expected/sm, "Message found: $expected" ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_positive_integer.t0000644000101700007640000000140514733067030021320 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 11; use Carp::Assert::More; use Test::Exception; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, FAIL ], [ 0.4, FAIL ], [ -10, FAIL ], [ 'dog', FAIL ], [ '14.', FAIL ], [ '14', PASS ], ); for my $case ( @cases ) { my ($val,$status) = @{$case}; my $desc = 'Checking ' . ($val // 'undef'); if ( $status eq FAIL ) { throws_ok( sub { assert_positive_integer( $val ) }, qr/Assertion failed/, $desc ); } else { lives_ok( sub { assert_positive_integer( $val ) }, $desc ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_nonzero.t0000644000101700007640000000125314733067030017434 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ undef, FAIL ], [ '', FAIL ], [ [], FAIL ], [ {}, FAIL ], [ 5, PASS ], [ 0, FAIL ], [ 0.4, PASS ], [ -10, PASS ], [ "dog", FAIL ], [ "14.", PASS ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = 'Checking ' . ($val // 'undef'); eval { assert_nonzero( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } exit 0; Carp-Assert-More-2.9.0/t/assert_fail.t0000644000101700007640000000026514733067030016657 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 1; use Carp::Assert::More; eval { assert_fail( "Everything is broken!" ); }; like( $@, qr/Everything is broken!/ ); Carp-Assert-More-2.9.0/t/assert_isnt.t0000644000101700007640000000134214733067030016716 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 8; use Carp::Assert::More; use Test::Exception; lives_ok { assert_isnt( 4, 3 ) } "4 is not 3"; lives_ok { assert_isnt( undef, "" ) } "Undef is not space"; lives_ok { assert_isnt( "", undef ) } "Space is not undef"; throws_ok { assert_isnt( undef, undef ) } qr/Assertion.+failed/, "Undef only matches undef"; throws_ok { assert_isnt( "a", "a" ) } qr/Assertion.+failed/, "a is a"; throws_ok { assert_isnt( 4, 4 ) } qr/Assertion.+failed/, "4 is 4"; throws_ok { assert_isnt( "", "" ) } qr/Assertion.+failed/, "space is space"; throws_ok { assert_isnt( "14", 14 ) } qr/Assertion.+failed/, "14 is 14 as strings"; Carp-Assert-More-2.9.0/t/assert_nonempty.t0000644000101700007640000000256014733067030017615 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 12; use Test::Exception; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 0; my @cases = ( [ 0 => FAIL ], [ 'foo' => FAIL ], [ undef => FAIL ], [ {} => FAIL ], [ [] => FAIL ], [ {foo=>1} => PASS ], [ [1,2,3] => PASS ], ); for my $case ( @cases ) { my ($val,$expected_status) = @$case; eval { assert_nonempty( $val ) }; my $desc = 'Checking ' . ($val // 'undef'); if ( $expected_status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } NOT_AN_ARRAY: { throws_ok( sub { assert_nonempty( 27 ) }, qr/Assertion failed!.+Argument is not a hash or array\./sm ); } BLESSED_ARRAY: { my $array_object = bless( [], 'WackyPackage' ); throws_ok( sub { assert_nonempty( $array_object, 'Flooble' ) }, qr/\QAssertion (Flooble) failed!\E.+Array contains 0 elements\./sm ); push( @{$array_object}, 14 ); lives_ok( sub { assert_nonempty( $array_object ) } ); } BLESSED_HASH: { my $hash_object = bless( {}, 'WackyPackage' ); throws_ok( sub { assert_nonempty( $hash_object, 'Flargle' ) }, qr/\QAssertion (Flargle) failed!\E.+Hash contains 0 keys\./sm ); $hash_object->{foo} = 14; lives_ok( sub { assert_nonempty( $hash_object ) } ); } exit 0 Carp-Assert-More-2.9.0/t/assert_arrayref_all.t0000644000101700007640000000321514733067030020405 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; my $api = \&assert_positive_integer; MAIN: { # {} is not an arrayref. throws_ok( sub { assert_arrayref_all( {}, $api ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref_all( $ref, $api ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref_all( 3, $api ) }, $FAILED ); # [] is a nonempty arrayref. lives_ok( sub { assert_arrayref_all( [ 3 ], $api ) } ); # [] is an empty arrayref. throws_ok( sub { assert_arrayref_all( [], $api ) }, $FAILED ); my @empty_ary = (); throws_ok( sub { assert_arrayref_all( \@empty_ary, $api ) }, qr/Array contains no elements/ ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref_all( $coderef, $api ) }, $FAILED ); # An arrayref is not a coderef. throws_ok( sub { assert_arrayref_all( \@empty_ary, [] ) }, qr/assert_arrayref_all requires a code reference/ ); } MASS_ASSERTIONS: { my @things = ( 1, 2, 4.3 ); throws_ok( sub { assert_arrayref_all( \@things, $api ) }, qr/assert_arrayref_all: Element #2/, 'Automatic name comes back OK' ); throws_ok( sub { assert_arrayref_all( \@things, $api, 'All gotta be posint' ) }, qr/All gotta be posint: Element #2/, 'Automatic name comes back OK' ); @things = 1..400; assert_arrayref_all( \@things, $api, 'Must all be positive integer' ); } exit 0; Carp-Assert-More-2.9.0/t/assert_is.t0000644000101700007640000000123314733067030016353 0ustar alesterispc#!perl use warnings; use strict; use Test::More tests => 8; use Carp::Assert::More; use Test::Exception; throws_ok { assert_is( 4, 3 ) } qr/Assertion.*failed/, "4 is not 3"; throws_ok { assert_is( undef, "" ) } qr/Assertion.*failed/, "Undef is not space"; throws_ok { assert_is( "", undef ) } qr/Assertion.*failed/, "Space is not undef"; lives_ok { assert_is( undef, undef ) } "Undef only matches undef"; lives_ok { assert_is( "a", "a" ) } "a is a"; lives_ok { assert_is( 4, 4 ) } "4 is 4"; lives_ok { assert_is( "", "" ) } "space is space"; lives_ok { assert_is( "14", 14 ) } "14 is 14 as strings"; Carp-Assert-More-2.9.0/INSTALL0000644000101700007640000000106014435534264014765 0ustar alesterispcWHAT IS THIS? This is Carp::Assert::More, a perl module. Please see the README that comes with this distribution. HOW DO I INSTALL IT? To install this module, cd to the directory that contains this README file and type the following: perl Makefile.PL make make test make install To install this module into a specific directory, do: perl Makefile.PL PREFIX=/name/of/the/directory ...the rest is the same... Please also read the perlmodinstall man page, if available. WHAT MODULES DO I NEED? Carp, which comes standard with Perl. Carp-Assert-More-2.9.0/Changes0000644000101700007640000001726614762222102015232 0ustar alesterispcRevision history for Perl extension Carp::Assert::More. 2.9.0 Wed Mar 5 22:27:28 CST 2025 [ENHANCEMENTS] assert_arrayref_of() no longer requires the array to have at least one element. New assert_arrayref_nonempty_of() has the same behavior as assert_arrayref_of(), but requires at least one element. 2.8.0 Fri Jan 3 12:03:58 CST 2025 [ENHANCEMENTS] Added assert_regex(). 2.7.0 Wed Dec 25 14:40:15 CST 2024 [ENHANCEMENTS] Added assert_numeric_between() and assert_integer_between(). 2.6.0 Sun Dec 22 23:37:00 CST 2024 [ENHANCEMENTS] Add assert(), the same as assert() in Carp::Assert, as a convenience. Add assert_and(), assert_or() and assert_xor() for more helpful stacktraces. 2.5.0 Fri Oct 25 14:46:06 CDT 2024 [ENHANCEMENTS] Add assert_context_list() function. Add assert_context_void() function. 2.4.0 Mon Mar 4 21:54:07 CST 2024 [ENHANCEMENTS] New function assert_arrayref_all() calls an assertion function for every element in the array. my $aref_of_counts = get_counts(); assert_arrayref_all( $aref, \&assert_positive_integer, 'Counts are positive' ); assert_context_scalar() now provides a default message of "function_name must be called in scalar context". assert_context_nonvoid() now provide a default message of "function_name must not be called in void context". 2.3.0 Tue May 30 21:52:20 CDT 2023 [ENHANCEMENTS] Added assert_arrayref_of() to verify that all of the elements in an arrayref are of a given type. For example: my $users = get_users(); assert_arrayref_of( $users, 'My::User' ); 2.2.0 Sun Jan 29 20:23:59 CST 2023 [ENHANCEMENTS] Added assert_cmp( $x, $op, $y [, $msg] ), analogous to cmp_ok in Test::More, so you can do assert_cmp( $n, '>', 10 ); which will give better diagnostics than just assert( $n > 10 ); Operators supported are: lt le gt ge == != > >= < <= assert_all_keys_in() now lists all key failures in the message, not just the first one. assert_keys_are() now lists all key failures in the message, not just the first one. 2.1.0 Mon Aug 15 19:54:27 CDT 2022 [ENHANCEMENTS] Add diagnostic strings to the failures. For example: assert_nonblank( [ 'foo' ], 'This should be nonblank' ); would fail with: Assertion (This should be nonblank) failed! but now fails with: Assertion (This should be nonblank) failed! Value is a reference to ARRAY. Similar changes have been made to: * assert_all_keys_in * assert_keys_are * assert_empty * assert_nonempty 2.0.1 Fri Aug 13 11:57:15 CDT 2021 [FIXES] assert_all_keys_in() mistakenly required a non-empty list of keys to check. [ENHANCEMENTS] Sped up assert_isa_in(), assert_is(). 2.0.0 Thu Aug 12 23:00::00 CDT 2021 [DIFFERENCES] Now requires Perl 5.10 or higher. No longer requires Carp::Assert. The numeric functions are more stringent now. If it expects a number, then you need to pass a number. For example, assert_nonnegative($x) would pass if $x was a non-numeric string. Now it must be numeric. assert_empty() and assert_nonempty() no longer gives a message of "Not an array or hash reference". If you don't pass an array or hash reference, the assertion will just fail with the message passe3d in. assert_aoh() and assert_datetime() no longer provide a default message. assert_in() is more strict. Each element of the target array is checked to not be a reference. assert_exists() and assert_lacks() are more strict. The list of keys to check cannot be empty. [ENHANCEMENTS] Most of the functions are about twice as fast because of reduced number of function calls internally. Added assert_context_nonvoid() and assert_context_scalar() to assert on how the executing function has been called. assert_in() now lets you use undef as both the needle and one of the values in the haystack. 1.26 Sat Dec 26 00:26:23 CST 2020 [ENHANCEMENTS] Add assert_arrayref_nonempty(). Add assert_hashref_nonempty(). 1.24 Tue Oct 6 22:37:06 CDT 2020 [ENHANCEMENTS] The requirement for Perl 5.10 has been reverted to 5.6.1. 1.22 Tue Oct 6 22:03:55 CDT 2020 [ENHANCEMENTS] Add assert_keys_are() for asserting an exact list of keys. 1.20 Fri Aug 9 10:10:06 CDT 2019 [ENHANCEMENTS] Add assert_datetime() for asserting DateTime objects. 1.18 Fri Jul 19 17:12:32 CDT 2019 [ENHANCEMENTS] Added assert_aoh() for asserting an array of hashrefs. 1.16 Fri Aug 4 14:18:51 CDT 2017 [ENHANCEMENTS] Added the following functions: * assert_numeric( $n ) * assert_all_keys_in( \%hash, \@keylist ) * assert_empty( [\%hash|\@list] ) * assert_coderef( $ref ) * assert_isa_in( $ref, \@class_list ) Thanks to Eric A. Zarko for some of them. The rest were migrated from a private code project. Renamed assert_listref() to assert_arrayref(), but keep assert_listref() as backward compatibility. assert_listref() may go away in the future. [DOCUMENTATION] Fixed a goof in the assert_integer() docs. Thanks, Randy Lauen. 1.14 Wed Oct 31 11:37:04 CDT 2012 [ENHANCEMENTS] Added assert_undefined() for Ben Hengst. Added assert_unlike(). [FIXES] assert_nonblank() wasn't using the correct message. Thanks to Leland Johnson. assert_nonempty() wouldn't work on blessed arrays and refs. Now it will. 1.12 Oct 14 2005 [ENHANCEMENTS] * Added assert_nonnegative() and assert_nonnegative_integer(). * Added assert_lacks(). Thanks to Bob Diss. 1.10 Wed Feb 16 12:52:16 CST 2005 [FIXES] * Fixed assert_positive_integer() to not pass "14.". 1.08 Wed Nov 24 11:44:34 CST 2004 [ENHANCEMENTS] * Added assert_is() and assert_isnt() * Organized the functions into logical groupings. [INTERNALS] * Now requires Test::Exception. * Added t/pod.t and t/pod-coverage.t 1.06 Sat Oct 30 23:50:45 CDT 2004 * No functionality changes. Just added a Copyright notice to so we can put it in Debian. 1.04 Mon Oct 18 10:21:37 CDT 2004 [ENHANCEMENTS] * assert_isa() is now aware of subclasses. [FIXES] * $names weren't getting passed to sub-assertions. Now they are. [DOCUMENTATION] * Documentation fix. This is the "all thanks to Allard Hoeve" release. 1.02 Tue Oct 5 17:31:56 CDT 2004 [ENHANCEMENTS] * Added assert_hashref() and assert_listref(). Thanks to Dan Friedman. 1.00 Wed Sep 22 10:14:28 CDT 2004 * First real official version. I'm not sure what's different between this and 0.04. * Added a bunch of new assert_* functions. Thanks David Storrs and Pete Krawczyk. 0.04 August 21, 2002 - Added assert_integer - Added assert_nonzero - Added assert_nonzero_integer - Added assert_exists 0.03 August 15, 2002 - Added assert_fail 0.02 August 8, 2002 - Added assert_nonblank and assert_nonref 0.01 August 8, 2002 - Original version, stolen from Carp::Assert Carp-Assert-More-2.9.0/More.pm0000644000101700007640000011404114762221760015175 0ustar alesterispcpackage Carp::Assert::More; use 5.010; use strict; use warnings; use parent 'Exporter'; use Scalar::Util qw( looks_like_number ); use vars qw( $VERSION @ISA @EXPORT ); =head1 NAME Carp::Assert::More - Convenience assertions for common situations =head1 VERSION Version 2.9.0 =cut our $VERSION = '2.9.0'; our @EXPORT = qw( assert assert_all_keys_in assert_and assert_aoh assert_arrayref assert_arrayref_nonempty assert_arrayref_nonempty_of assert_arrayref_of assert_arrayref_all assert_cmp assert_coderef assert_context_list assert_context_nonvoid assert_context_scalar assert_context_void assert_datetime assert_defined assert_empty assert_exists assert_fail assert_hashref assert_hashref_nonempty assert_in assert_integer assert_integer_between assert_is assert_isa assert_isa_in assert_isnt assert_keys_are assert_lacks assert_like assert_listref assert_negative assert_negative_integer assert_nonblank assert_nonempty assert_nonnegative assert_nonnegative_integer assert_nonref assert_nonzero assert_nonzero_integer assert_numeric assert_numeric_between assert_or assert_positive assert_positive_integer assert_regex assert_undefined assert_unlike assert_xor ); my $INTEGER = qr/^-?\d+$/; =head1 SYNOPSIS A set of convenience functions for common assertions. use Carp::Assert::More; my $obj = My::Object; assert_isa( $obj, 'My::Object', 'Got back a correct object' ); =head1 DESCRIPTION Carp::Assert::More is a convenient set of assertions to make the habit of writing assertions even easier. Everything in here is effectively syntactic sugar. There's no technical difference between calling one of these functions: assert_datetime( $foo ); assert_isa( $foo, 'DateTime' ); that are provided by Carp::Assert::More and calling these assertions from Carp::Assert assert( defined $foo ); assert( ref($foo) eq 'DateTime' ); My intent here is to make common assertions easy so that we as programmers have no excuse to not use them. =head1 SIMPLE ASSERTIONS =head2 assert( $condition [, $name] ) Asserts that C<$condition> is a true value. This is the same as C in C, provided as a convenience. =cut sub assert($;$) { my $condition = shift; my $name = shift; return if $condition; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_is( $string, $match [,$name] ) Asserts that I<$string> is the same string value as I<$match>. C is not converted to an empty string. If both strings are C, they match. If only one string is C, they don't match. =cut sub assert_is($$;$) { my $string = shift; my $match = shift; my $name = shift; if ( defined($string) ) { return if defined($match) && ($string eq $match); } else { return if !defined($match); } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_isnt( $string, $unmatch [,$name] ) Asserts that I<$string> does NOT have the same string value as I<$unmatch>. C is not converted to an empty string. =cut sub assert_isnt($$;$) { my $string = shift; my $unmatch = shift; my $name = shift; # undef only matches undef return if defined($string) xor defined($unmatch); return if defined($string) && defined($unmatch) && ($string ne $unmatch); require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_cmp( $x, $op, $y [,$name] ) Asserts that the relation C<$x $op $y> is true. It lets you know why the comparsison failed, rather than simply that it did fail, by giving better diagnostics than a plain C, as well as showing the operands in the stacktrace. Plain C: assert( $nitems <= 10, 'Ten items or fewer in the express lane' ); Assertion (Ten items or fewer in the express lane) failed! Carp::Assert::assert("", "Ten items or fewer in the express lane") called at foo.pl line 12 With C: assert_cmp( $nitems, '<=', 10, 'Ten items or fewer in the express lane' ); Assertion (Ten items or fewer in the express lane) failed! Failed: 14 <= 10 Carp::Assert::More::assert_cmp(14, "<=", 10, "Ten items or fewer in the express lane") called at foo.pl line 11 The following operators are supported: =over 4 =item * == numeric equal =item * != numeric not equal =item * > numeric greater than =item * >= numeric greater than or equal =item * < numeric less than =item * <= numeric less than or equal =item * lt string less than =item * le string less than or equal =item * gt string less than =item * ge string less than or equal =back There is no support for C or C because those already have C and C, respectively. If either C<$x> or C<$y> is undef, the assertion will fail. If the operator is numeric, and C<$x> or C<$y> are not numbers, the assertion will fail. =cut sub assert_cmp($$$;$) { my $x = shift; my $op = shift; my $y = shift; my $name = shift; my $why; if ( !defined($op) ) { $why = 'Invalid operator '; } elsif ( $op eq '==' ) { return if looks_like_number($x) && looks_like_number($y) && ($x == $y); } elsif ( $op eq '!=' ) { return if looks_like_number($x) && looks_like_number($y) && ($x != $y); } elsif ( $op eq '<' ) { return if looks_like_number($x) && looks_like_number($y) && ($x < $y); } elsif ( $op eq '<=' ) { return if looks_like_number($x) && looks_like_number($y) && ($x <= $y); } elsif ( $op eq '>' ) { return if looks_like_number($x) && looks_like_number($y) && ($x > $y); } elsif ( $op eq '>=' ) { return if looks_like_number($x) && looks_like_number($y) && ($x >= $y); } elsif ( $op eq 'lt' ) { return if defined($x) && defined($y) && ($x lt $y); } elsif ( $op eq 'le' ) { return if defined($x) && defined($y) && ($x le $y); } elsif ( $op eq 'gt' ) { return if defined($x) && defined($y) && ($x gt $y); } elsif ( $op eq 'ge' ) { return if defined($x) && defined($y) && ($x ge $y); } else { $why = qq{Invalid operator "$op"}; } $why //= "Failed: " . ($x // 'undef') . ' ' . $op . ' ' . ($y // 'undef'); require Carp; &Carp::confess( _failure_msg($name, $why) ); } =head2 assert_like( $string, qr/regex/ [,$name] ) Asserts that I<$string> matches I. The assertion fails either the string or the regex are undef. =cut sub assert_like($$;$) { my $string = shift; my $regex = shift; my $name = shift; if ( defined($string) && !ref($string) ) { if ( ref($regex) ) { return if $string =~ $regex; } } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_unlike( $string, qr/regex/ [,$name] ) Asserts that I<$string> matches I. The assertion fails if the regex is undef. =cut sub assert_unlike($$;$) { my $string = shift; my $regex = shift; my $name = shift; return if !defined($string); if ( ref($regex) eq 'Regexp' ) { return if $string !~ $regex; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_defined( $this [, $name] ) Asserts that I<$this> is defined. =cut sub assert_defined($;$) { return if defined( $_[0] ); require Carp; &Carp::confess( _failure_msg($_[1]) ); } =head2 assert_undefined( $this [, $name] ) Asserts that I<$this> is not defined. =cut sub assert_undefined($;$) { return unless defined( $_[0] ); require Carp; &Carp::confess( _failure_msg($_[1]) ); } =head2 assert_nonblank( $this [, $name] ) Asserts that I<$this> is not a reference and is not an empty string. =cut sub assert_nonblank($;$) { my $this = shift; my $name = shift; my $why; if ( !defined($this) ) { $why = 'Value is undef.'; } else { if ( ref($this) ) { $why = 'Value is a reference to ' . ref($this) . '.'; } else { return if $this ne ''; $why = 'Value is blank.'; } } require Carp; &Carp::confess( _failure_msg($name, $why) ); } =head1 BOOLEAN ASSERTIONS These boolean assertions help make diagnostics more useful. If you use C with a boolean condition: assert( $x && $y, 'Both X and Y should be true' ); you can't tell why it failed: Assertion (Both X and Y should be true) failed! at .../Carp/Assert/More.pm line 123 Carp::Assert::More::assert(undef, 'Both X and Y should be true') called at foo.pl line 16 But if you use C: assert_and( $x, $y, 'Both X and Y should be true' ); the stacktrace tells you which half of the expression failed. Assertion (Both X and Y should be true) failed! at .../Carp/Assert/More.pm line 123 Carp::Assert::More::assert_and('thing', undef, 'Both X and Y should be true') called at foo.pl line 16 =head2 assert_and( $x, $y [, $name] ) Asserts that both C<$x> and C<$y> are true. =cut sub assert_and($$;$) { my $x = shift; my $y = shift; my $name = shift; return if $x && $y; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_or( $x, $y [, $name] ) Asserts that at least one of C<$x> or C<$y> are true. =cut sub assert_or($$;$) { my $x = shift; my $y = shift; my $name = shift; return if $x || $y; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_xor( $x, $y [, $name] ) Asserts that C<$x> is true, or C<$y> is true, but not both. =cut sub assert_xor($$;$) { my $x = shift; my $y = shift; my $name = shift; return if $x && !$y; return if $y && !$x; require Carp; &Carp::confess( _failure_msg($name) ); } =head1 NUMERIC ASSERTIONS =head2 assert_numeric( $n [, $name] ) Asserts that C<$n> looks like a number, according to C. C will always fail. =cut sub assert_numeric { my $n = shift; my $name = shift; return if Scalar::Util::looks_like_number( $n ); require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_integer( $this [, $name ] ) Asserts that I<$this> is an integer, which may be zero or negative. assert_integer( 0 ); # pass assert_integer( 14 ); # pass assert_integer( -14 ); # pass assert_integer( '14.' ); # FAIL =cut sub assert_integer($;$) { my $this = shift; my $name = shift; if ( defined($this) ) { return if $this =~ $INTEGER; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_nonzero( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined and is not zero. assert_nonzero( 0 ); # FAIL assert_nonzero( -14 ); # pass assert_nonzero( '14.' ); # pass =cut sub assert_nonzero($;$) { my $this = shift; my $name = shift; if ( Scalar::Util::looks_like_number($this) ) { return if $this != 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_positive( $this [, $name ] ) Asserts that I<$this> is defined, numeric and greater than zero. assert_positive( 0 ); # FAIL assert_positive( -14 ); # FAIL assert_positive( '14.' ); # pass =cut sub assert_positive($;$) { my $this = shift; my $name = shift; if ( Scalar::Util::looks_like_number($this) ) { return if ($this+0 > 0); } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_nonnegative( $this [, $name ] ) Asserts that I<$this> is defined, numeric and greater than or equal to zero. assert_nonnegative( 0 ); # pass assert_nonnegative( -14 ); # FAIL assert_nonnegative( '14.' ); # pass assert_nonnegative( 'dog' ); # pass =cut sub assert_nonnegative($;$) { my $this = shift; my $name = shift; if ( Scalar::Util::looks_like_number( $this ) ) { return if $this >= 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_negative( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined and less than zero. assert_negative( 0 ); # FAIL assert_negative( -14 ); # pass assert_negative( '14.' ); # FAIL =cut sub assert_negative($;$) { my $this = shift; my $name = shift; no warnings; return if defined($this) && ($this+0 < 0); require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_nonzero_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined, an integer, and not zero. assert_nonzero_integer( 0 ); # FAIL assert_nonzero_integer( -14 ); # pass assert_nonzero_integer( '14.' ); # FAIL =cut sub assert_nonzero_integer($;$) { my $this = shift; my $name = shift; if ( defined($this) && ($this =~ $INTEGER) ) { return if $this != 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_positive_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined, an integer and greater than zero. assert_positive_integer( 0 ); # FAIL assert_positive_integer( -14 ); # FAIL assert_positive_integer( '14.' ); # FAIL assert_positive_integer( '14' ); # pass =cut sub assert_positive_integer($;$) { my $this = shift; my $name = shift; if ( defined($this) && ($this =~ $INTEGER) ) { return if $this > 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_nonnegative_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined, an integer, and not less than zero. assert_nonnegative_integer( 0 ); # pass assert_nonnegative_integer( -14 ); # FAIL assert_nonnegative_integer( '14.' ); # FAIL =cut sub assert_nonnegative_integer($;$) { my $this = shift; my $name = shift; if ( defined($this) && ($this =~ $INTEGER) ) { return if $this >= 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_negative_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is defined, an integer, and less than zero. assert_negative_integer( 0 ); # FAIL assert_negative_integer( -14 ); # pass assert_negative_integer( '14.' ); # FAIL =cut sub assert_negative_integer($;$) { my $this = shift; my $name = shift; if ( defined($this) && ($this =~ $INTEGER) ) { return if $this < 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_numeric_between( $n, $lo, $hi [, $name ] ) Asserts that the value of I<$this> is defined, numeric and between C<$lo> and C<$hi>, inclusive. assert_numeric_between( 15, 10, 100 ); # pass assert_numeric_between( 10, 15, 100 ); # FAIL assert_numeric_between( 3.14, 1, 10 ); # pass =cut sub assert_numeric_between($$$;$) { my $n = shift; my $lo = shift; my $hi = shift; my $name = shift; if ( Scalar::Util::looks_like_number( $n ) ) { return if $lo <= $n && $n <= $hi; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_integer_between( $n, $lo, $hi [, $name ] ) Asserts that the value of I<$this> is defined, an integer, and between C<$lo> and C<$hi>, inclusive. assert_integer_between( 15, 10, 100 ); # pass assert_integer_between( 10, 15, 100 ); # FAIL assert_integer_between( 3.14, 1, 10 ); # FAIL =cut sub assert_integer_between($$$;$) { my $n = shift; my $lo = shift; my $hi = shift; my $name = shift; if ( defined($n) && $n =~ $INTEGER ) { return if $lo <= $n && $n <= $hi; } require Carp; &Carp::confess( _failure_msg($name) ); } =head1 REFERENCE ASSERTIONS =head2 assert_isa( $this, $type [, $name ] ) Asserts that I<$this> is an object of type I<$type>. =cut sub assert_isa($$;$) { my $this = shift; my $type = shift; my $name = shift; # The assertion is true if # 1) For objects, $this is of class $type or of a subclass of $type # 2) For non-objects, $this is a reference to a HASH, SCALAR, ARRAY, etc. return if Scalar::Util::blessed( $this ) && $this->isa( $type ); return if ref($this) eq $type; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_isa_in( $obj, \@types [, $description] ) Assert that the blessed C<$obj> isa one of the types in C<\@types>. assert_isa_in( $obj, [ 'My::Foo', 'My::Bar' ], 'Must pass either a Foo or Bar object' ); =cut sub assert_isa_in($$;$) { my $obj = shift; my $types = shift; my $name = shift; if ( Scalar::Util::blessed($obj) ) { for ( @{$types} ) { return if $obj->isa($_); } } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_empty( $this [, $name ] ) I<$this> must be a ref to either a hash or an array. Asserts that that collection contains no elements. Will assert (with its own message, not I<$name>) unless given a hash or array ref. It is OK if I<$this> has been blessed into objecthood, but the semantics of checking an object to see if it does not have keys (for a hashref) or returns 0 in scalar context (for an array ref) may not be what you want. assert_empty( 0 ); # FAIL assert_empty( 'foo' ); # FAIL assert_empty( undef ); # FAIL assert_empty( {} ); # pass assert_empty( [] ); # pass assert_empty( {foo=>1} );# FAIL assert_empty( [1,2,3] ); # FAIL =cut sub assert_empty($;$) { my $ref = shift; my $name = shift; my $underlying_type; if ( Scalar::Util::blessed( $ref ) ) { $underlying_type = Scalar::Util::reftype( $ref ); } else { $underlying_type = ref( $ref ); } my $why; my $n; if ( $underlying_type eq 'HASH' ) { return if scalar keys %{$ref} == 0; $n = scalar keys %{$ref}; $why = "Hash contains $n key"; } elsif ( $underlying_type eq 'ARRAY' ) { return if @{$ref} == 0; $n = scalar @{$ref}; $why = "Array contains $n element"; } else { $why = 'Argument is not a hash or array.'; } $why .= 's' if $n && ($n>1); $why .= '.'; require Carp; &Carp::confess( _failure_msg($name, $why) ); } =head2 assert_nonempty( $this [, $name ] ) I<$this> must be a ref to either a hash or an array. Asserts that that collection contains at least 1 element. Will assert (with its own message, not I<$name>) unless given a hash or array ref. It is OK if I<$this> has been blessed into objecthood, but the semantics of checking an object to see if it has keys (for a hashref) or returns >0 in scalar context (for an array ref) may not be what you want. assert_nonempty( 0 ); # FAIL assert_nonempty( 'foo' ); # FAIL assert_nonempty( undef ); # FAIL assert_nonempty( {} ); # FAIL assert_nonempty( [] ); # FAIL assert_nonempty( {foo=>1} );# pass assert_nonempty( [1,2,3] ); # pass =cut sub assert_nonempty($;$) { my $ref = shift; my $name = shift; my $underlying_type; if ( Scalar::Util::blessed( $ref ) ) { $underlying_type = Scalar::Util::reftype( $ref ); } else { $underlying_type = ref( $ref ); } my $why; my $n; if ( $underlying_type eq 'HASH' ) { return if scalar keys %{$ref} > 0; $why = "Hash contains 0 keys."; } elsif ( $underlying_type eq 'ARRAY' ) { return if scalar @{$ref} > 0; $why = "Array contains 0 elements."; } else { $why = 'Argument is not a hash or array.'; } require Carp; &Carp::confess( _failure_msg($name, $why) ); } =head2 assert_nonref( $this [, $name ] ) Asserts that I<$this> is not undef and not a reference. =cut sub assert_nonref($;$) { my $this = shift; my $name = shift; assert_defined( $this, $name ); return unless ref( $this ); require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_hashref( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to a (possibly empty) hash. B This method returns I for objects, even those whose underlying data is a hashref. This is as it should be, under the assumptions that: =over 4 =item (a) you shouldn't rely on the underlying data structure of a particular class, and =item (b) you should use C instead. =back =cut sub assert_hashref($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'HASH' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'HASH' )) ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_hashref_nonempty( $ref [,$name] ) Asserts that I<$ref> is defined and is a reference to a hash with at least one key/value pair. =cut sub assert_hashref_nonempty($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'HASH' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'HASH' )) ) { return if scalar keys %{$ref} > 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_arrayref( $ref [, $name] ) =head2 assert_listref( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to an array, which may or may not be empty. B The same caveat about objects whose underlying structure is a hash (see C) applies here; this method returns false even for objects whose underlying structure is an array. C is an alias for C and may go away in the future. Use C instead. =cut sub assert_arrayref($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } *assert_listref = *assert_arrayref; =head2 assert_arrayref_nonempty( $ref [, $name] ) Asserts that I<$ref> is reference to an array that has at least one element in it. =cut sub assert_arrayref_nonempty($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { return if scalar @{$ref} > 0; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_arrayref_of( $ref, $type [, $name] ) Asserts that I<$ref> is reference to an array, and any/all elements are of type I<$type>. For example: my @users = get_users(); assert_arrayref_of( \@users, 'My::User' ); =cut sub assert_arrayref_of($$;$) { my $ref = shift; my $type = shift; my $name = shift; my $ok; my @why; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { my $n = 0; for my $i ( @{$ref} ) { if ( !( ( Scalar::Util::blessed( $i ) && $i->isa( $type ) ) || (ref($i) eq $type) ) ) { push @why, "Element #$n is not of type $type"; } ++$n; } $ok = !@why; } if ( !$ok ) { require Carp; &Carp::confess( _failure_msg($name), @why ); } return; } =head2 assert_arrayref_nonempty_of( $ref, $type [, $name] ) Asserts that I<$ref> is reference to an array, that it has at least one element, and that all elements are of type I<$type>. This is the same function as C, except that it also requires at least one element. =cut sub assert_arrayref_nonempty_of($$;$) { my $ref = shift; my $type = shift; my $name = shift; my $ok; my @why; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { if ( scalar @{$ref} > 0 ) { my $n = 0; for my $i ( @{$ref} ) { if ( !( ( Scalar::Util::blessed( $i ) && $i->isa( $type ) ) || (ref($i) eq $type) ) ) { push @why, "Element #$n is not of type $type"; } ++$n; } $ok = !@why; } else { push @why, 'Array contains no elements'; } } if ( !$ok ) { require Carp; &Carp::confess( _failure_msg($name), @why ); } return; } =head2 assert_arrayref_all( $aref, $sub [, $name] ) Asserts that I<$aref> is reference to an array that has at least one element in it. Each element of the array is passed to subroutine I<$sub> which is assumed to be an assertion. For example: my $aref_of_counts = get_counts(); assert_arrayref_all( $aref, \&assert_positive_integer, 'Counts are positive' ); Whatever is passed as I<$name>, a string saying "Element #N" will be appended, where N is the zero-based index of the array. =cut sub assert_arrayref_all($$;$) { my $aref = shift; my $sub = shift; my $name = shift; my @why; assert_coderef( $sub, 'assert_arrayref_all requires a code reference' ); if ( ref($aref) eq 'ARRAY' || (Scalar::Util::blessed( $aref ) && $aref->isa( 'ARRAY' )) ) { if ( @{$aref} ) { my $inner_msg = defined($name) ? "$name: " : 'assert_arrayref_all: '; my $n = 0; for my $i ( @{$aref} ) { $sub->( $i, "${inner_msg}Element #$n" ); ++$n; } } else { push @why, 'Array contains no elements'; } } else { push @why, 'First argument to assert_arrayref_all was not an array'; } if ( @why ) { require Carp; &Carp::confess( _failure_msg($name), @why ); } return; } =head2 assert_aoh( $ref [, $name ] ) Verifies that C<$array> is an arrayref, and that every element is a hashref. The array C<$array> can be an empty arraref and the assertion will pass. =cut sub assert_aoh { my $ref = shift; my $name = shift; my $ok = 0; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { $ok = 1; for my $val ( @{$ref} ) { if ( not ( ref($val) eq 'HASH' || (Scalar::Util::blessed( $val) && $val->isa( 'HASH' )) ) ) { $ok = 0; last; } } } return if $ok; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_coderef( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to a closure. =cut sub assert_coderef($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'CODE' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'CODE' )) ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_regex( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to a regex. It is functionally the same as C. =cut sub assert_regex($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'Regexp' ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } =head1 TYPE-SPECIFIC ASSERTIONS =head2 assert_datetime( $date ) Asserts that C<$date> is a DateTime object. =cut sub assert_datetime($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'DateTime' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'DateTime' )) ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } =head1 SET AND HASH MEMBERSHIP =head2 assert_in( $string, \@inlist [,$name] ); Asserts that I<$string> matches one of the elements of I<\@inlist>. I<$string> may be undef. I<\@inlist> must be an array reference of non-ref strings. If any element is a reference, the assertion fails. =cut sub assert_in($$;$) { my $needle = shift; my $haystack = shift; my $name = shift; my $found = 0; # String has to be a non-ref scalar, or undef. if ( !ref($needle) ) { # Target list has to be an array... if ( ref($haystack) eq 'ARRAY' || (Scalar::Util::blessed( $haystack ) && $haystack->isa( 'ARRAY' )) ) { # ... and all elements have to be non-refs. my $elements_ok = 1; foreach my $element (@{$haystack}) { if ( ref($element) ) { $elements_ok = 0; last; } } # Now we can actually do the search. if ( $elements_ok ) { if ( defined($needle) ) { foreach my $element (@{$haystack}) { if ( $needle eq $element ) { $found = 1; last; } } } else { foreach my $element (@{$haystack}) { if ( !defined($element) ) { $found = 1; last; } } } } } } return if $found; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_exists( \%hash, $key [,$name] ) =head2 assert_exists( \%hash, \@keylist [,$name] ) Asserts that I<%hash> is indeed a hash, and that I<$key> exists in I<%hash>, or that all of the keys in I<@keylist> exist in I<%hash>. assert_exists( \%custinfo, 'name', 'Customer has a name field' ); assert_exists( \%custinfo, [qw( name addr phone )], 'Customer has name, address and phone' ); =cut sub assert_exists($$;$) { my $hash = shift; my $key = shift; my $name = shift; my $ok = 0; if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) && $hash->isa( 'HASH' )) ) { if ( defined($key) ) { if ( ref($key) eq 'ARRAY' ) { $ok = (@{$key} > 0); for ( @{$key} ) { if ( !exists( $hash->{$_} ) ) { $ok = 0; last; } } } elsif ( !ref($key) ) { $ok = exists( $hash->{$key} ); } else { $ok = 0; } } } return if $ok; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_lacks( \%hash, $key [,$name] ) =head2 assert_lacks( \%hash, \@keylist [,$name] ) Asserts that I<%hash> is indeed a hash, and that I<$key> does NOT exist in I<%hash>, or that none of the keys in I<@keylist> exist in I<%hash>. The list C<@keylist> cannot be empty. assert_lacks( \%users, 'root', 'Root is not in the user table' ); assert_lacks( \%users, [qw( root admin nobody )], 'No bad usernames found' ); =cut sub assert_lacks($$;$) { my $hash = shift; my $key = shift; my $name = shift; my $ok = 0; if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) && $hash->isa( 'HASH' )) ) { if ( defined($key) ) { if ( ref($key) eq 'ARRAY' ) { $ok = (@{$key} > 0); for ( @{$key} ) { if ( exists( $hash->{$_} ) ) { $ok = 0; last; } } } elsif ( !ref($key) ) { $ok = !exists( $hash->{$key} ); } else { $ok = 0; } } } return if $ok; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_all_keys_in( \%hash, \@names [, $name ] ) Asserts that each key in C<%hash> is in the list of C<@names>. This is used to ensure that there are no extra keys in a given hash. assert_all_keys_in( $obj, [qw( height width depth )], '$obj can only contain height, width and depth keys' ); You can pass an empty list of C<@names>. =cut sub assert_all_keys_in($$;$) { my $hash = shift; my $keys = shift; my $name = shift; my @why; my $ok = 0; if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) && $hash->isa( 'HASH' )) ) { if ( ref($keys) eq 'ARRAY' ) { $ok = 1; my %keys = map { $_ => 1 } @{$keys}; for my $key ( keys %{$hash} ) { if ( !exists $keys{$key} ) { $ok = 0; push @why, qq{Key "$key" is not a valid key.}; } } } else { push @why, 'Argument for array of keys is not an arrayref.'; } } else { push @why, 'Argument for hash is not a hashref.'; } return if $ok; require Carp; &Carp::confess( _failure_msg($name, @why) ); } =head2 assert_keys_are( \%hash, \@keys [, $name ] ) Asserts that the keys for C<%hash> are exactly C<@keys>, no more and no less. =cut sub assert_keys_are($$;$) { my $hash = shift; my $keys = shift; my $name = shift; my @why; my $ok = 0; if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) && $hash->isa( 'HASH' )) ) { if ( ref($keys) eq 'ARRAY' ) { my %keys = map { $_ => 1 } @{$keys}; # First check all the keys are allowed. $ok = 1; for my $key ( keys %{$hash} ) { if ( !exists $keys{$key} ) { $ok = 0; push @why, qq{Key "$key" is not a valid key.}; } } # Now check that all the valid keys are represented. for my $key ( @{$keys} ) { if ( !exists $hash->{$key} ) { $ok = 0; push @why, qq{Key "$key" is not in the hash.}; } } } else { push @why, 'Argument for array of keys is not an arrayref.'; } } else { push @why, 'Argument for hash is not a hashref.'; } return if $ok; require Carp; &Carp::confess( _failure_msg($name, @why) ); } =head1 CONTEXT ASSERTIONS =head2 assert_context_nonvoid( [$name] ) Verifies that the function currently being executed has not been called in void context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_nonvoid(); return $important_value; } These calls to C will pass: my $val = something(); my @things = something(); but this will fail: something(); If the C<$name> argument is not passed, a default message of " must not be called in void context" is provided. =cut sub assert_context_nonvoid(;$) { my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1); return if defined($wantarray); my $name = $_[0] // "$subroutine must not be called in void context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_context_void( [$name] ) Verifies that the function currently being executed has been called in void context. This is for functions that do not return anything meaningful. Given this function: sub something { ... assert_context_void(); return; # No meaningful value. } These calls to C will fail: my $val = something(); my @things = something(); but this will pass: something(); If the C<$name> argument is not passed, a default message of " must be called in void context" is provided. =cut sub assert_context_void(;$) { my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1); return if not defined($wantarray); my $name = $_[0] // "$subroutine must be called in void context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_context_scalar( [$name] ) Verifies that the function currently being executed has been called in scalar context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_scalar(); return $important_value; } This call to C will pass: my $val = something(); but these will fail: something(); my @things = something(); If the C<$name> argument is not passed, a default message of " must be called in scalar context" is provided. =cut sub assert_context_scalar(;$) { my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1); return if defined($wantarray) && !$wantarray; my $name = $_[0] // "$subroutine must be called in scalar context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_context_list( [$name] ) Verifies that the function currently being executed has been called in list context. Given this function: sub something { ... assert_context_scalar(); return @values; } This call to C will pass: my @vals = something(); but these will fail: something(); my $thing = something(); If the C<$name> argument is not passed, a default message of " must be called in list context" is provided. =cut sub assert_context_list(;$) { my (undef, undef, undef, $subroutine, undef, $wantarray) = caller(1); return if $wantarray; my $name = shift // "$subroutine must be called in list context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head1 UTILITY ASSERTIONS =head2 assert_fail( [$name] ) Assertion that always fails. C is exactly the same as calling C, but it eliminates that case where you accidentally use C, which of course never fires. =cut sub assert_fail(;$) { require Carp; &Carp::confess( _failure_msg($_[0]) ); } # Can't call confess() here or the stack trace will be wrong. sub _failure_msg { my ($name, @why) = @_; my $msg = 'Assertion'; $msg .= " ($name)" if defined $name; $msg .= " failed!\n"; $msg .= "$_\n" for @why; return $msg; } =head1 COPYRIGHT & LICENSE Copyright 2005-2025 Andy Lester This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =head1 ACKNOWLEDGEMENTS Thanks to Eric A. Zarko, Bob Diss, Pete Krawczyk, David Storrs, Dan Friedman, Allard Hoeve, Thomas L. Shinnick, and Leland Johnson for code and fixes. =cut 1; Carp-Assert-More-2.9.0/README.md0000644000101700007640000004062014736024410015207 0ustar alesterispc# Carp::Assert::More [![Build Status](https://github.com/petdance/carp-assert-more/workflows/testsuite/badge.svg?branch=dev)](https://github.com/petdance/carp-assert-more/actions?query=workflow%3Atestsuite+branch%3Adev) # NAME Carp::Assert::More - Convenience assertions for common situations # VERSION Version 2.8.0 # SYNOPSIS A set of convenience functions for common assertions. use Carp::Assert::More; my $obj = My::Object; assert_isa( $obj, 'My::Object', 'Got back a correct object' ); # DESCRIPTION Carp::Assert::More is a convenient set of assertions to make the habit of writing assertions even easier. Everything in here is effectively syntactic sugar. There's no technical difference between calling one of these functions: assert_datetime( $foo ); assert_isa( $foo, 'DateTime' ); that are provided by Carp::Assert::More and calling these assertions from Carp::Assert assert( defined $foo ); assert( ref($foo) eq 'DateTime' ); My intent here is to make common assertions easy so that we as programmers have no excuse to not use them. # SIMPLE ASSERTIONS ## assert( $condition \[, $name\] ) Asserts that `$condition` is a true value. This is the same as `assert` in `Carp::Assert`, provided as a convenience. ## assert\_is( $string, $match \[,$name\] ) Asserts that _$string_ is the same string value as _$match_. `undef` is not converted to an empty string. If both strings are `undef`, they match. If only one string is `undef`, they don't match. ## assert\_isnt( $string, $unmatch \[,$name\] ) Asserts that _$string_ does NOT have the same string value as _$unmatch_. `undef` is not converted to an empty string. ## assert\_cmp( $x, $op, $y \[,$name\] ) Asserts that the relation `$x $op $y` is true. It lets you know why the comparsison failed, rather than simply that it did fail, by giving better diagnostics than a plain `assert()`, as well as showing the operands in the stacktrace. Plain `assert()`: assert( $nitems <= 10, 'Ten items or fewer in the express lane' ); Assertion (Ten items or fewer in the express lane) failed! Carp::Assert::assert("", "Ten items or fewer in the express lane") called at foo.pl line 12 With `assert_cmp()`: assert_cmp( $nitems, '<=', 10, 'Ten items or fewer in the express lane' ); Assertion (Ten items or fewer in the express lane) failed! Failed: 14 <= 10 Carp::Assert::More::assert_cmp(14, "<=", 10, "Ten items or fewer in the express lane") called at foo.pl line 11 The following operators are supported: - == numeric equal - != numeric not equal - > numeric greater than - >= numeric greater than or equal - < numeric less than - <= numeric less than or equal - lt string less than - le string less than or equal - gt string less than - ge string less than or equal There is no support for `eq` or `ne` because those already have `assert_is` and `assert_isnt`, respectively. If either `$x` or `$y` is undef, the assertion will fail. If the operator is numeric, and `$x` or `$y` are not numbers, the assertion will fail. ## assert\_like( $string, qr/regex/ \[,$name\] ) Asserts that _$string_ matches _qr/regex/_. The assertion fails either the string or the regex are undef. ## assert\_unlike( $string, qr/regex/ \[,$name\] ) Asserts that _$string_ matches _qr/regex/_. The assertion fails if the regex is undef. ## assert\_defined( $this \[, $name\] ) Asserts that _$this_ is defined. ## assert\_undefined( $this \[, $name\] ) Asserts that _$this_ is not defined. ## assert\_nonblank( $this \[, $name\] ) Asserts that _$this_ is not a reference and is not an empty string. # BOOLEAN ASSERTIONS These boolean assertions help make diagnostics more useful. If you use `assert` with a boolean condition: assert( $x && $y, 'Both X and Y should be true' ); you can't tell why it failed: Assertion (Both X and Y should be true) failed! at .../Carp/Assert/More.pm line 123 Carp::Assert::More::assert(undef, 'Both X and Y should be true') called at foo.pl line 16 But if you use `assert_and`: assert_and( $x, $y, 'Both X and Y should be true' ); the stacktrace tells you which half of the expression failed. Assertion (Both X and Y should be true) failed! at .../Carp/Assert/More.pm line 123 Carp::Assert::More::assert_and('thing', undef, 'Both X and Y should be true') called at foo.pl line 16 ## assert\_and( $x, $y \[, $name\] ) Asserts that both `$x` and `$y` are true. ## assert\_or( $x, $y \[, $name\] ) Asserts that at least one of `$x` or `$y` are true. ## assert\_xor( $x, $y \[, $name\] ) Asserts that `$x` is true, or `$y` is true, but not both. # NUMERIC ASSERTIONS ## assert\_numeric( $n \[, $name\] ) Asserts that `$n` looks like a number, according to `Scalar::Util::looks_like_number`. `undef` will always fail. ## assert\_integer( $this \[, $name \] ) Asserts that _$this_ is an integer, which may be zero or negative. assert_integer( 0 ); # pass assert_integer( 14 ); # pass assert_integer( -14 ); # pass assert_integer( '14.' ); # FAIL ## assert\_nonzero( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined and is not zero. assert_nonzero( 0 ); # FAIL assert_nonzero( -14 ); # pass assert_nonzero( '14.' ); # pass ## assert\_positive( $this \[, $name \] ) Asserts that _$this_ is defined, numeric and greater than zero. assert_positive( 0 ); # FAIL assert_positive( -14 ); # FAIL assert_positive( '14.' ); # pass ## assert\_nonnegative( $this \[, $name \] ) Asserts that _$this_ is defined, numeric and greater than or equal to zero. assert_nonnegative( 0 ); # pass assert_nonnegative( -14 ); # FAIL assert_nonnegative( '14.' ); # pass assert_nonnegative( 'dog' ); # pass ## assert\_negative( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined and less than zero. assert_negative( 0 ); # FAIL assert_negative( -14 ); # pass assert_negative( '14.' ); # FAIL ## assert\_nonzero\_integer( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined, an integer, and not zero. assert_nonzero_integer( 0 ); # FAIL assert_nonzero_integer( -14 ); # pass assert_nonzero_integer( '14.' ); # FAIL ## assert\_positive\_integer( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined, an integer and greater than zero. assert_positive_integer( 0 ); # FAIL assert_positive_integer( -14 ); # FAIL assert_positive_integer( '14.' ); # FAIL assert_positive_integer( '14' ); # pass ## assert\_nonnegative\_integer( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined, an integer, and not less than zero. assert_nonnegative_integer( 0 ); # pass assert_nonnegative_integer( -14 ); # FAIL assert_nonnegative_integer( '14.' ); # FAIL ## assert\_negative\_integer( $this \[, $name \] ) Asserts that the numeric value of _$this_ is defined, an integer, and less than zero. assert_negative_integer( 0 ); # FAIL assert_negative_integer( -14 ); # pass assert_negative_integer( '14.' ); # FAIL ## assert\_numeric\_between( $n, $lo, $hi \[, $name \] ) Asserts that the value of _$this_ is defined, numeric and between `$lo` and `$hi`, inclusive. assert_numeric_between( 15, 10, 100 ); # pass assert_numeric_between( 10, 15, 100 ); # FAIL assert_numeric_between( 3.14, 1, 10 ); # pass ## assert\_integer\_between( $n, $lo, $hi \[, $name \] ) Asserts that the value of _$this_ is defined, an integer, and between `$lo` and `$hi`, inclusive. assert_integer_between( 15, 10, 100 ); # pass assert_integer_between( 10, 15, 100 ); # FAIL assert_integer_between( 3.14, 1, 10 ); # FAIL # REFERENCE ASSERTIONS ## assert\_isa( $this, $type \[, $name \] ) Asserts that _$this_ is an object of type _$type_. ## assert\_isa\_in( $obj, \\@types \[, $description\] ) Assert that the blessed `$obj` isa one of the types in `\@types`. assert_isa_in( $obj, [ 'My::Foo', 'My::Bar' ], 'Must pass either a Foo or Bar object' ); ## assert\_empty( $this \[, $name \] ) _$this_ must be a ref to either a hash or an array. Asserts that that collection contains no elements. Will assert (with its own message, not _$name_) unless given a hash or array ref. It is OK if _$this_ has been blessed into objecthood, but the semantics of checking an object to see if it does not have keys (for a hashref) or returns 0 in scalar context (for an array ref) may not be what you want. assert_empty( 0 ); # FAIL assert_empty( 'foo' ); # FAIL assert_empty( undef ); # FAIL assert_empty( {} ); # pass assert_empty( [] ); # pass assert_empty( {foo=>1} );# FAIL assert_empty( [1,2,3] ); # FAIL ## assert\_nonempty( $this \[, $name \] ) _$this_ must be a ref to either a hash or an array. Asserts that that collection contains at least 1 element. Will assert (with its own message, not _$name_) unless given a hash or array ref. It is OK if _$this_ has been blessed into objecthood, but the semantics of checking an object to see if it has keys (for a hashref) or returns >0 in scalar context (for an array ref) may not be what you want. assert_nonempty( 0 ); # FAIL assert_nonempty( 'foo' ); # FAIL assert_nonempty( undef ); # FAIL assert_nonempty( {} ); # FAIL assert_nonempty( [] ); # FAIL assert_nonempty( {foo=>1} );# pass assert_nonempty( [1,2,3] ); # pass ## assert\_nonref( $this \[, $name \] ) Asserts that _$this_ is not undef and not a reference. ## assert\_hashref( $ref \[,$name\] ) Asserts that _$ref_ is defined, and is a reference to a (possibly empty) hash. **NB:** This method returns _false_ for objects, even those whose underlying data is a hashref. This is as it should be, under the assumptions that: - (a) you shouldn't rely on the underlying data structure of a particular class, and - (b) you should use `assert_isa` instead. ## assert\_hashref\_nonempty( $ref \[,$name\] ) Asserts that _$ref_ is defined and is a reference to a hash with at least one key/value pair. ## assert\_arrayref( $ref \[, $name\] ) ## assert\_listref( $ref \[,$name\] ) Asserts that _$ref_ is defined, and is a reference to an array, which may or may not be empty. **NB:** The same caveat about objects whose underlying structure is a hash (see `assert_hashref`) applies here; this method returns false even for objects whose underlying structure is an array. `assert_listref` is an alias for `assert_arrayref` and may go away in the future. Use `assert_arrayref` instead. ## assert\_arrayref\_nonempty( $ref \[, $name\] ) Asserts that _$ref_ is reference to an array that has at least one element in it. ## assert\_arrayref\_of( $ref, $type \[, $name\] ) Asserts that _$ref_ is reference to an array that has at least one element in it, and every one of those elements is of type _$type_. For example: my @users = get_users(); assert_arrayref_of( \@users, 'My::User' ); ## assert\_arrayref\_all( $aref, $sub \[, $name\] ) Asserts that _$aref_ is reference to an array that has at least one element in it. Each element of the array is passed to subroutine _$sub_ which is assumed to be an assertion. For example: my $aref_of_counts = get_counts(); assert_arrayref_all( $aref, \&assert_positive_integer, 'Counts are positive' ); Whatever is passed as _$name_, a string saying "Element #N" will be appended, where N is the zero-based index of the array. ## assert\_aoh( $ref \[, $name \] ) Verifies that `$array` is an arrayref, and that every element is a hashref. The array `$array` can be an empty arraref and the assertion will pass. ## assert\_coderef( $ref \[,$name\] ) Asserts that _$ref_ is defined, and is a reference to a closure. ## assert\_regex( $ref \[,$name\] ) Asserts that _$ref_ is defined, and is a reference to a regex. It is functionally the same as `assert_isa( $ref, 'Regexp' )`. # TYPE-SPECIFIC ASSERTIONS ## assert\_datetime( $date ) Asserts that `$date` is a DateTime object. # SET AND HASH MEMBERSHIP ## assert\_in( $string, \\@inlist \[,$name\] ); Asserts that _$string_ matches one of the elements of _\\@inlist_. _$string_ may be undef. _\\@inlist_ must be an array reference of non-ref strings. If any element is a reference, the assertion fails. ## assert\_exists( \\%hash, $key \[,$name\] ) ## assert\_exists( \\%hash, \\@keylist \[,$name\] ) Asserts that _%hash_ is indeed a hash, and that _$key_ exists in _%hash_, or that all of the keys in _@keylist_ exist in _%hash_. assert_exists( \%custinfo, 'name', 'Customer has a name field' ); assert_exists( \%custinfo, [qw( name addr phone )], 'Customer has name, address and phone' ); ## assert\_lacks( \\%hash, $key \[,$name\] ) ## assert\_lacks( \\%hash, \\@keylist \[,$name\] ) Asserts that _%hash_ is indeed a hash, and that _$key_ does NOT exist in _%hash_, or that none of the keys in _@keylist_ exist in _%hash_. The list `@keylist` cannot be empty. assert_lacks( \%users, 'root', 'Root is not in the user table' ); assert_lacks( \%users, [qw( root admin nobody )], 'No bad usernames found' ); ## assert\_all\_keys\_in( \\%hash, \\@names \[, $name \] ) Asserts that each key in `%hash` is in the list of `@names`. This is used to ensure that there are no extra keys in a given hash. assert_all_keys_in( $obj, [qw( height width depth )], '$obj can only contain height, width and depth keys' ); You can pass an empty list of `@names`. ## assert\_keys\_are( \\%hash, \\@keys \[, $name \] ) Asserts that the keys for `%hash` are exactly `@keys`, no more and no less. # CONTEXT ASSERTIONS ## assert\_context\_nonvoid( \[$name\] ) Verifies that the function currently being executed has not been called in void context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_nonvoid(); return $important_value; } These calls to `something` will pass: my $val = something(); my @things = something(); but this will fail: something(); If the `$name` argument is not passed, a default message of "<funcname> must not be called in void context" is provided. ## assert\_context\_void( \[$name\] ) Verifies that the function currently being executed has been called in void context. This is for functions that do not return anything meaningful. Given this function: sub something { ... assert_context_void(); return; # No meaningful value. } These calls to `something` will fail: my $val = something(); my @things = something(); but this will pass: something(); If the `$name` argument is not passed, a default message of "<funcname> must be called in void context" is provided. ## assert\_context\_scalar( \[$name\] ) Verifies that the function currently being executed has been called in scalar context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_scalar(); return $important_value; } This call to `something` will pass: my $val = something(); but these will fail: something(); my @things = something(); If the `$name` argument is not passed, a default message of "<funcname> must be called in scalar context" is provided. ## assert\_context\_list( \[$name\] ) Verifies that the function currently being executed has been called in list context. Given this function: sub something { ... assert_context_scalar(); return @values; } This call to `something` will pass: my @vals = something(); but these will fail: something(); my $thing = something(); If the `$name` argument is not passed, a default message of "<funcname> must be called in list context" is provided. # UTILITY ASSERTIONS ## assert\_fail( \[$name\] ) Assertion that always fails. `assert_fail($msg)` is exactly the same as calling `assert(0,$msg)`, but it eliminates that case where you accidentally use `assert($msg)`, which of course never fires. # COPYRIGHT & LICENSE Copyright 2005-2025 Andy Lester This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. # ACKNOWLEDGEMENTS Thanks to Eric A. Zarko, Bob Diss, Pete Krawczyk, David Storrs, Dan Friedman, Allard Hoeve, Thomas L. Shinnick, and Leland Johnson for code and fixes. Carp-Assert-More-2.9.0/MANIFEST0000644000101700007640000000246314762222357015075 0ustar alesterispcChanges cpanfile INSTALL MANIFEST Makefile.PL More.pm README.md t/00-load.t t/assert.t t/assert_all_keys_in.t t/assert_and.t t/assert_aoh.t t/assert_arrayref.t t/assert_arrayref_all.t t/assert_arrayref_nonempty.t t/assert_arrayref_nonempty_of.t t/assert_arrayref_of.t t/assert_cmp.t t/assert_coderef.t t/assert_context_list.t t/assert_context_nonvoid.t t/assert_context_scalar.t t/assert_context_void.t t/assert_datetime.t t/assert_defined.t t/assert_empty.t t/assert_exists.t t/assert_fail.t t/assert_hashref.t t/assert_hashref_nonempty.t t/assert_in.t t/assert_integer.t t/assert_integer_between.t t/assert_is.t t/assert_isa.t t/assert_isa_in.t t/assert_isnt.t t/assert_keys_are.t t/assert_lacks.t t/assert_like.t t/assert_listref.t t/assert_negative_integer.t t/assert_negative.t t/assert_nonblank.t t/assert_nonempty.t t/assert_nonnegative_integer.t t/assert_nonnegative.t t/assert_nonref.t t/assert_nonzero_integer.t t/assert_nonzero.t t/assert_numeric.t t/assert_numeric_between.t t/assert_or.t t/assert_positive_integer.t t/assert_positive.t t/assert_regex.t t/assert_undefined.t t/assert_unlike.t t/assert_xor.t t/pod.t t/pod-coverage.t t/test-coverage.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Carp-Assert-More-2.9.0/Makefile.PL0000644000101700007640000000274614733067030015713 0ustar alesterispcpackage main; use 5.010; use strict; use warnings; use ExtUtils::MakeMaker 6.64; my %parms = ( NAME => 'Carp::Assert::More', VERSION_FROM => 'More.pm', # finds $VERSION LICENSE => 'artistic_2', MIN_PERL_VERSION => '5.10.1', PM => { 'More.pm' => '$(INST_LIB)/Carp/Assert/More.pm', }, PREREQ_PM => { Carp => 0, 'Scalar::Util' => 0, }, BUILD_REQUIRES => { 'ExtUtils::MakeMaker' => 6.64, }, TEST_REQUIRES => { 'Test::Exception' => 0, 'Test::More' => 0.72, }, dist => { COMPRESS => 'gzip -9', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', }, META_MERGE => { resources => { homepage => 'https://github.com/petdance/carp-assert-more', bugtracker => 'https://github.com/petdance/carp-assert-more/issues', repository => 'git@github.com:petdance/carp-assert-more.git', license => 'https://opensource.org/licenses/artistic-license-2.0.php', } }, ); WriteMakefile( %parms ); package MY; sub MY::postamble { my $postamble = <<'MAKE_FRAG'; .PHONY: critic tags critic: perlcritic -1 -q -profile perlcriticrc More.pm t/*.t tags: ctags -f tags --recurse --totals \ --exclude=blib \ --exclude=.git \ --exclude='*~' \ --languages=Perl --langmap=Perl:+.t \ MAKE_FRAG return $postamble; } 1; Carp-Assert-More-2.9.0/cpanfile0000644000101700007640000000047614733067030015443 0ustar alesterispc# Validate with cpanfile-dump # https://metacpan.org/release/Module-CPANfile requires 'Carp' => 0; requires 'Scalar::Util' => 0; on 'build' => sub { requires 'ExtUtils::MakeMaker' => 6.64; }; on 'test' => sub { requires 'Test::More', '0.72'; requires 'Test::Exception', 0; }; # vi:et:sw=4 ts=4 ft=perl Carp-Assert-More-2.9.0/META.yml0000644000101700007640000000134414762222357015212 0ustar alesterispc--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '6.64' Test::Exception: '0' Test::More: '0.72' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.143240' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Carp-Assert-More no_index: directory: - t - inc requires: Carp: '0' Scalar::Util: '0' perl: '5.010001' resources: bugtracker: https://github.com/petdance/carp-assert-more/issues homepage: https://github.com/petdance/carp-assert-more license: https://opensource.org/licenses/artistic-license-2.0.php version: v2.9.0 Carp-Assert-More-2.9.0/META.json0000644000101700007640000000245514762222357015366 0ustar alesterispc{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.143240", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Carp-Assert-More", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.64" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Scalar::Util" : "0", "perl" : "5.010001" } }, "test" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0.72" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/petdance/carp-assert-more/issues" }, "homepage" : "https://github.com/petdance/carp-assert-more", "license" : [ "https://opensource.org/licenses/artistic-license-2.0.php" ] }, "version" : "v2.9.0" }