Carp-Assert-More-2.3.0/0000755000101700007640000000000014435534127013727 5ustar alesterispcCarp-Assert-More-2.3.0/t/0000755000101700007640000000000014435534127014172 5ustar alesterispcCarp-Assert-More-2.3.0/t/assert_nonempty.t0000644000101700007640000000256414276564536017632 0ustar alesterispc#!perl -Tw 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.3.0/t/pod-coverage.t0000644000101700007640000000040312737244634016733 0ustar alesterispc#!perl -T 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.3.0/t/pod.t0000644000101700007640000000036612737244634015152 0ustar alesterispc#!perl -T 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.3.0/t/assert_nonzero.t0000644000101700007640000000125714105520466017432 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_isnt.t0000644000101700007640000000134612737244634016725 0ustar alesterispc#!perl -Tw 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.3.0/t/test-coverage.t0000644000101700007640000000057114435532313017125 0ustar alesterispc#!perl -Tw use Test::More tests => 41; 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.3.0/t/assert_integer.t0000644000101700007640000000137314105520466017374 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_positive_integer.t0000644000101700007640000000141114105520466021307 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_isa_in.t0000644000101700007640000000366514105520466017207 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_fail.t0000644000101700007640000000027113141144243016640 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_in.t0000644000101700007640000000310514261642561016344 0ustar alesterispc#!/usr/bin/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.3.0/t/assert_undefined.t0000644000101700007640000000076612737244634017716 0ustar alesterispc#!perl -T 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.3.0/t/assert_nonnegative_integer.t0000644000101700007640000000127314105520466021770 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_context_nonvoid.t0000644000101700007640000000113214105520466021150 0ustar alesterispc#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 3; use Carp::Assert::More; sub important_function { assert_context_nonvoid( 'important_function must not be called in void context' ); 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 (important_function must not be called in void context) failed!/ ); exit 0; Carp-Assert-More-2.3.0/t/assert_unlike.t0000644000101700007640000000173214105520466017225 0ustar alesterispc#!/usr/bin/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.3.0/t/assert_datetime.t0000644000101700007640000000134614105520466017533 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_isa.t0000644000101700007640000000160114105520466016505 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_coderef.t0000644000101700007640000000173713141144243017344 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_cmp.t0000644000101700007640000001664314366746767016553 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_exists.t0000644000101700007640000000211614105520466017252 0ustar alesterispc#!perl -T 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.3.0/t/assert_hashref_nonempty.t0000644000101700007640000000225114105337242021302 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_numeric.t0000644000101700007640000000137314105520466017401 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_nonnegative.t0000644000101700007640000000125114105520466020247 0ustar alesterispc#!perl -T 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.3.0/t/assert_lacks.t0000644000101700007640000000115614105520466017033 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_keys_are.t0000644000101700007640000000463314366746767017572 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_negative_integer.t0000644000101700007640000000132014105520466021246 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_all_keys_in.t0000644000101700007640000000351314366746767020255 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_aoh.t0000644000101700007640000000227614105520466016511 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_context_scalar.t0000644000101700007640000000123414105520466020744 0ustar alesterispc#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 3; use Carp::Assert::More; sub important_function { assert_context_scalar( 'important_function must be called in scalar context' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (important_function must be called in scalar context) failed!/ ); # Call in list context. eval { my @x = important_function(); }; like( $@, qr/\QAssertion (important_function must be called in scalar context) failed!/ ); exit 0; Carp-Assert-More-2.3.0/t/assert_nonzero_integer.t0000644000101700007640000000125614105520466021146 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_nonref.t0000644000101700007640000000113614105520466017223 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_is.t0000644000101700007640000000123712737244634016362 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_listref.t0000644000101700007640000000170512737244634017417 0ustar alesterispc#!perl -Tw 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.3.0/t/00-load.t0000644000101700007640000000031512737244634015516 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_defined.t0000644000101700007640000000065512737244634017350 0ustar alesterispc#!perl -T 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.3.0/t/assert_arrayref_nonempty.t0000644000101700007640000000252614105520466021504 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_nonblank.t0000644000101700007640000000165614276564536017564 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_positive.t0000644000101700007640000000126214105520466017576 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_negative.t0000644000101700007640000000125014105520466017533 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_arrayref_of.t0000644000101700007640000000256214435533111020234 0ustar alesterispc#!perl -Tw 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. throws_ok( sub { assert_arrayref_of( [], 'Foo' ) }, $FAILED ); my @empty_ary = (); throws_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.3.0/t/assert_arrayref.t0000644000101700007640000000166114105520466017552 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_hashref.t0000644000101700007640000000156214105337242017355 0ustar alesterispc#!perl -Tw 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.3.0/t/assert_like.t0000644000101700007640000000150612737244634016672 0ustar alesterispc#!/usr/bin/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.3.0/t/assert_empty.t0000644000101700007640000000332014276564536017106 0ustar alesterispc#!perl -Tw 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.3.0/cpanfile0000644000101700007640000000043514105520466015430 0ustar alesterispc# Validate with cpanfile-dump # https://metacpan.org/release/Module-CPANfile requires 'Carp' => 0; requires 'Scalar::Util' => 0; on 'test' => sub { requires 'Test::More', '0.94'; # So we can run subtests on v5.10 requires 'Test::Exception', 0; }; # vi:et:sw=4 ts=4 ft=perl Carp-Assert-More-2.3.0/INSTALL0000644000101700007640000000106014105520466014750 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.3.0/Changes0000644000101700007640000001437614435533304015231 0ustar alesterispcRevision history for Perl extension Carp::Assert::More. 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.3.0/README.md0000644000101700007640000002542314105520466015207 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.0.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 assert_isa( $foo, 'DateTime' ); or assert\_datetime( $foo ); 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\_is( $string, $match \[,$name\] ) Asserts that _$string_ matches _$match_. ## assert\_isnt( $string, $unmatch \[,$name\] ) Asserts that _$string_ does NOT match _$unmatch_. ## 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. # 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 # 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\_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. # 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' ); ## 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_scalar(); return $important_value; } These calls to `something` will pass: my $val = something(); my @things = something(); but this will fail: something(); ## 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(); # 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-2021 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.3.0/Makefile.PL0000644000101700007640000000260114435527641015703 0ustar alesterispcpackage main; use 5.10.1; use strict; use warnings; use ExtUtils::MakeMaker 6.46; 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, 'Test::Exception' => 0, 'Test::More' => 0.18, }, 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.3.0/MANIFEST0000644000101700007640000000211514435534130015051 0ustar alesterispcChanges cpanfile INSTALL MANIFEST Makefile.PL More.pm README.md t/00-load.t t/assert_all_keys_in.t t/assert_aoh.t t/assert_arrayref.t t/assert_arrayref_nonempty.t t/assert_arrayref_of.t t/assert_cmp.t t/assert_coderef.t t/assert_context_nonvoid.t t/assert_context_scalar.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_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_positive_integer.t t/assert_positive.t t/assert_undefined.t t/assert_unlike.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.3.0/More.pm0000644000101700007640000007454014435534041015174 0ustar alesterispcpackage Carp::Assert::More; use 5.010; use strict; use warnings; use 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.3.0 =cut BEGIN { $VERSION = '2.3.0'; @ISA = qw(Exporter); @EXPORT = qw( assert_all_keys_in assert_aoh assert_arrayref assert_arrayref_nonempty assert_arrayref_of assert_cmp assert_coderef assert_context_nonvoid assert_context_scalar assert_datetime assert_defined assert_empty assert_exists assert_fail assert_hashref assert_hashref_nonempty assert_in assert_integer 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_positive assert_positive_integer assert_undefined assert_unlike ); } 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_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 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) ); } =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 that has at least one element in it, and every one of those elements is 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' )) ) { 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_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) ); } =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_scalar(); return $important_value; } These calls to C will pass: my $val = something(); my @things = something(); but this will fail: something(); =cut sub assert_context_nonvoid(;$) { my $name = shift; my $wantarray = (caller(1))[5]; return if defined($wantarray); 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(); =cut sub assert_context_scalar(;$) { my $name = shift; my $wantarray = (caller(1))[5]; return if defined($wantarray) && !$wantarray; 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-2023 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.3.0/META.yml0000644000101700007640000000143314435534127015201 0ustar alesterispc--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' 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' Test::Exception: '0' Test::More: '0.18' 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.3.0 x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Carp-Assert-More-2.3.0/META.json0000644000101700007640000000245314435534127015354 0ustar alesterispc{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "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" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Scalar::Util" : "0", "Test::Exception" : "0", "Test::More" : "0.18", "perl" : "5.010001" } } }, "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.3.0", "x_serialization_backend" : "JSON::PP version 2.27400" }