Carp-Assert-More-2.4.0/0000755000101700007640000000000014571513714013730 5ustar alesterispcCarp-Assert-More-2.4.0/t/0000755000101700007640000000000014571513714014173 5ustar alesterispcCarp-Assert-More-2.4.0/t/assert_integer.t0000644000101700007640000000137314435534264017404 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.4.0/t/assert_context_scalar.t0000644000101700007640000000324514571513652020757 0ustar alesterispc#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; # First we test the assertions with an explicit message passed. sub important_function { assert_context_scalar( 'non-scalar context is bad' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (non-scalar context is bad) failed!/ ); # Call in list context. eval { my @x = important_function(); }; like( $@, qr/\QAssertion (non-scalar context is bad) failed!/ ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_scalar(); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = crucial_function(); }; is( $@, '' ); # Ignore the value returned. eval { crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in scalar context) failed!/ ); # Call in list context. eval { my @x = crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must be called in scalar context) failed!/ ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_scalar(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must be called in scalar context) failed!/ ); exit 0; Carp-Assert-More-2.4.0/t/assert_isa.t0000644000101700007640000000160114435534264016515 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.4.0/t/test-coverage.t0000644000101700007640000000057114571513652017134 0ustar alesterispc#!perl -Tw use Test::More tests => 42; 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.4.0/t/assert_nonnegative.t0000644000101700007640000000125114435534264020257 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.4.0/t/assert_empty.t0000644000101700007640000000332014435534264017077 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.4.0/t/assert_isnt.t0000644000101700007640000000134612737244634016726 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.4.0/t/assert_arrayref.t0000644000101700007640000000166114435534264017562 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.4.0/t/assert_unlike.t0000644000101700007640000000173214435534264017235 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.4.0/t/assert_nonnegative_integer.t0000644000101700007640000000127314435534264022000 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.4.0/t/pod.t0000644000101700007640000000036612737244634015153 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.4.0/t/assert_nonempty.t0000644000101700007640000000256414435534264017623 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.4.0/t/assert_negative.t0000644000101700007640000000125014435534264017543 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.4.0/t/assert_nonzero.t0000644000101700007640000000125714435534264017442 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.4.0/t/assert_negative_integer.t0000644000101700007640000000132014435534264021256 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.4.0/t/assert_keys_are.t0000644000101700007640000000463314435534266017555 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.4.0/t/00-load.t0000644000101700007640000000031512737244634015517 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.4.0/t/assert_isa_in.t0000644000101700007640000000366514435534264017217 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.4.0/t/assert_is.t0000644000101700007640000000123712737244634016363 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.4.0/t/assert_datetime.t0000644000101700007640000000134614435534264017543 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.4.0/t/assert_cmp.t0000644000101700007640000001664314435534266016536 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.4.0/t/assert_arrayref_of.t0000644000101700007640000000256214571505756020254 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.4.0/t/assert_positive_integer.t0000644000101700007640000000141114435534264021317 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.4.0/t/assert_context_nonvoid.t0000644000101700007640000000270214571513652021163 0ustar alesterispc#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 7; use Carp::Assert::More; sub important_function { assert_context_nonvoid( 'void is bad' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Keep the value in an array. eval { my @x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (void is bad) failed!/ ); # Now we test the assertions with the default message that the function provides. sub crucial_function { assert_context_nonvoid(); return 2112; } # Keep the value returned. eval { my $x = crucial_function(); }; is( $@, '' ); # Keep the value in an array. eval { my @x = crucial_function(); }; is( $@, '' ); # Ignore the value returned. eval { crucial_function(); }; like( $@, qr/\QAssertion (main::crucial_function must not be called in void context) failed!/ ); # Test the default function name through multiple levels in different packages. package Bingo::Bongo; use Carp::Assert::More; sub vital_function { assert_context_nonvoid(); } package Wango; sub uninteresting_function { Bingo::Bongo::vital_function(); } package main; # Ignore the value returned. eval { Wango::uninteresting_function(); }; like( $@, qr/\QAssertion (Bingo::Bongo::vital_function must not be called in void context) failed!/ ); exit 0; Carp-Assert-More-2.4.0/t/assert_nonblank.t0000644000101700007640000000165614435534264017555 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.4.0/t/pod-coverage.t0000644000101700007640000000040312737244634016734 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.4.0/t/assert_exists.t0000644000101700007640000000211614435534264017262 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.4.0/t/assert_numeric.t0000644000101700007640000000137314435534264017411 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.4.0/t/assert_nonref.t0000644000101700007640000000113614435534264017233 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.4.0/t/assert_nonzero_integer.t0000644000101700007640000000125614435534264021156 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.4.0/t/assert_hashref_nonempty.t0000644000101700007640000000225114435534264021314 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.4.0/t/assert_fail.t0000644000101700007640000000027113141144243016641 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.4.0/t/assert_aoh.t0000644000101700007640000000227614435534264016521 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.4.0/t/assert_hashref.t0000644000101700007640000000156214435534264017367 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.4.0/t/assert_like.t0000644000101700007640000000150612737244634016673 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.4.0/t/assert_listref.t0000644000101700007640000000170512737244634017420 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.4.0/t/assert_arrayref_all.t0000644000101700007640000000322114571513652020403 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 10; use Carp::Assert::More; use Test::Exception; my $FAILED = qr/Assertion failed/; my $api = \&assert_positive_integer; MAIN: { # {} is not an arrayref. throws_ok( sub { assert_arrayref_all( {}, $api ) }, $FAILED ); # A ref to a hash with stuff in it is not an arrayref. my $ref = { foo => 'foo', bar => 'bar' }; throws_ok( sub { assert_arrayref_all( $ref, $api ) }, $FAILED ); # 3 is not an arrayref. throws_ok( sub { assert_arrayref_all( 3, $api ) }, $FAILED ); # [] is a nonempty arrayref. lives_ok( sub { assert_arrayref_all( [ 3 ], $api ) } ); # [] is an empty arrayref. throws_ok( sub { assert_arrayref_all( [], $api ) }, $FAILED ); my @empty_ary = (); throws_ok( sub { assert_arrayref_all( \@empty_ary, $api ) }, qr/Array contains no elements/ ); # A coderef is not an arrayref. my $coderef = sub {}; throws_ok( sub { assert_arrayref_all( $coderef, $api ) }, $FAILED ); # An arrayref is not a coderef. throws_ok( sub { assert_arrayref_all( \@empty_ary, [] ) }, qr/assert_arrayref_all requires a code reference/ ); } MASS_ASSERTIONS: { my @things = ( 1, 2, 4.3 ); throws_ok( sub { assert_arrayref_all( \@things, $api ) }, qr/assert_arrayref_all: Element #2/, 'Automatic name comes back OK' ); throws_ok( sub { assert_arrayref_all( \@things, $api, 'All gotta be posint' ) }, qr/All gotta be posint: Element #2/, 'Automatic name comes back OK' ); @things = 1..400; assert_arrayref_all( \@things, $api, 'Must all be positive integer' ); } exit 0; Carp-Assert-More-2.4.0/t/assert_lacks.t0000644000101700007640000000115614435534264017043 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.4.0/t/assert_positive.t0000644000101700007640000000126214435534264017606 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.4.0/t/assert_undefined.t0000644000101700007640000000076612737244634017717 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.4.0/t/assert_arrayref_nonempty.t0000644000101700007640000000252614435534264021514 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.4.0/t/assert_in.t0000644000101700007640000000310514435534264016350 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.4.0/t/assert_all_keys_in.t0000644000101700007640000000351314435534266020240 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.4.0/t/assert_coderef.t0000644000101700007640000000173713141144243017345 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.4.0/t/assert_defined.t0000644000101700007640000000065512737244634017351 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.4.0/Changes0000644000101700007640000001545314571513652015234 0ustar alesterispcRevision history for Perl extension Carp::Assert::More. 2.4.0 Mon Mar 4 21:54:07 CST 2024 [ENHANCEMENTS] New function assert_arrayref_all() calls an assertion function for every element in the array. my $aref_of_counts = get_counts(); assert_arrayref_all( $aref, \&assert_positive_integer, 'Counts are positive' ); assert_context_scalar() now provides a default message of "function_name must be called in scalar context". assert_context_nonvoid() now provide a default message of "function_name must not be called in void context". 2.3.0 Tue May 30 21:52:20 CDT 2023 [ENHANCEMENTS] Added assert_arrayref_of() to verify that all of the elements in an arrayref are of a given type. For example: my $users = get_users(); assert_arrayref_of( $users, 'My::User' ); 2.2.0 Sun Jan 29 20:23:59 CST 2023 [ENHANCEMENTS] Added assert_cmp( $x, $op, $y [, $msg] ), analogous to cmp_ok in Test::More, so you can do assert_cmp( $n, '>', 10 ); which will give better diagnostics than just assert( $n > 10 ); Operators supported are: lt le gt ge == != > >= < <= assert_all_keys_in() now lists all key failures in the message, not just the first one. assert_keys_are() now lists all key failures in the message, not just the first one. 2.1.0 Mon Aug 15 19:54:27 CDT 2022 [ENHANCEMENTS] Add diagnostic strings to the failures. For example: assert_nonblank( [ 'foo' ], 'This should be nonblank' ); would fail with: Assertion (This should be nonblank) failed! but now fails with: Assertion (This should be nonblank) failed! Value is a reference to ARRAY. Similar changes have been made to: * assert_all_keys_in * assert_keys_are * assert_empty * assert_nonempty 2.0.1 Fri Aug 13 11:57:15 CDT 2021 [FIXES] assert_all_keys_in() mistakenly required a non-empty list of keys to check. [ENHANCEMENTS] Sped up assert_isa_in(), assert_is(). 2.0.0 Thu Aug 12 23:00::00 CDT 2021 [DIFFERENCES] Now requires Perl 5.10 or higher. No longer requires Carp::Assert. The numeric functions are more stringent now. If it expects a number, then you need to pass a number. For example, assert_nonnegative($x) would pass if $x was a non-numeric string. Now it must be numeric. assert_empty() and assert_nonempty() no longer gives a message of "Not an array or hash reference". If you don't pass an array or hash reference, the assertion will just fail with the message passe3d in. assert_aoh() and assert_datetime() no longer provide a default message. assert_in() is more strict. Each element of the target array is checked to not be a reference. assert_exists() and assert_lacks() are more strict. The list of keys to check cannot be empty. [ENHANCEMENTS] Most of the functions are about twice as fast because of reduced number of function calls internally. Added assert_context_nonvoid() and assert_context_scalar() to assert on how the executing function has been called. assert_in() now lets you use undef as both the needle and one of the values in the haystack. 1.26 Sat Dec 26 00:26:23 CST 2020 [ENHANCEMENTS] Add assert_arrayref_nonempty(). Add assert_hashref_nonempty(). 1.24 Tue Oct 6 22:37:06 CDT 2020 [ENHANCEMENTS] The requirement for Perl 5.10 has been reverted to 5.6.1. 1.22 Tue Oct 6 22:03:55 CDT 2020 [ENHANCEMENTS] Add assert_keys_are() for asserting an exact list of keys. 1.20 Fri Aug 9 10:10:06 CDT 2019 [ENHANCEMENTS] Add assert_datetime() for asserting DateTime objects. 1.18 Fri Jul 19 17:12:32 CDT 2019 [ENHANCEMENTS] Added assert_aoh() for asserting an array of hashrefs. 1.16 Fri Aug 4 14:18:51 CDT 2017 [ENHANCEMENTS] Added the following functions: * assert_numeric( $n ) * assert_all_keys_in( \%hash, \@keylist ) * assert_empty( [\%hash|\@list] ) * assert_coderef( $ref ) * assert_isa_in( $ref, \@class_list ) Thanks to Eric A. Zarko for some of them. The rest were migrated from a private code project. Renamed assert_listref() to assert_arrayref(), but keep assert_listref() as backward compatibility. assert_listref() may go away in the future. [DOCUMENTATION] Fixed a goof in the assert_integer() docs. Thanks, Randy Lauen. 1.14 Wed Oct 31 11:37:04 CDT 2012 [ENHANCEMENTS] Added assert_undefined() for Ben Hengst. Added assert_unlike(). [FIXES] assert_nonblank() wasn't using the correct message. Thanks to Leland Johnson. assert_nonempty() wouldn't work on blessed arrays and refs. Now it will. 1.12 Oct 14 2005 [ENHANCEMENTS] * Added assert_nonnegative() and assert_nonnegative_integer(). * Added assert_lacks(). Thanks to Bob Diss. 1.10 Wed Feb 16 12:52:16 CST 2005 [FIXES] * Fixed assert_positive_integer() to not pass "14.". 1.08 Wed Nov 24 11:44:34 CST 2004 [ENHANCEMENTS] * Added assert_is() and assert_isnt() * Organized the functions into logical groupings. [INTERNALS] * Now requires Test::Exception. * Added t/pod.t and t/pod-coverage.t 1.06 Sat Oct 30 23:50:45 CDT 2004 * No functionality changes. Just added a Copyright notice to so we can put it in Debian. 1.04 Mon Oct 18 10:21:37 CDT 2004 [ENHANCEMENTS] * assert_isa() is now aware of subclasses. [FIXES] * $names weren't getting passed to sub-assertions. Now they are. [DOCUMENTATION] * Documentation fix. This is the "all thanks to Allard Hoeve" release. 1.02 Tue Oct 5 17:31:56 CDT 2004 [ENHANCEMENTS] * Added assert_hashref() and assert_listref(). Thanks to Dan Friedman. 1.00 Wed Sep 22 10:14:28 CDT 2004 * First real official version. I'm not sure what's different between this and 0.04. * Added a bunch of new assert_* functions. Thanks David Storrs and Pete Krawczyk. 0.04 August 21, 2002 - Added assert_integer - Added assert_nonzero - Added assert_nonzero_integer - Added assert_exists 0.03 August 15, 2002 - Added assert_fail 0.02 August 8, 2002 - Added assert_nonblank and assert_nonref 0.01 August 8, 2002 - Original version, stolen from Carp::Assert Carp-Assert-More-2.4.0/MANIFEST0000644000101700007640000000214514571513714015063 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_all.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.4.0/INSTALL0000644000101700007640000000106014435534264014760 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.4.0/cpanfile0000644000101700007640000000043514435534264015440 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.4.0/README.md0000644000101700007640000002542314435534264015217 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.4.0/Makefile.PL0000644000101700007640000000260114435534306015700 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.4.0/More.pm0000644000101700007640000010006014571513652015166 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.4.0 =cut BEGIN { $VERSION = '2.4.0'; @ISA = qw(Exporter); @EXPORT = qw( assert_all_keys_in assert_aoh assert_arrayref assert_arrayref_nonempty assert_arrayref_of assert_arrayref_all 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_arrayref_all( $aref, $sub [, $name] ) Asserts that I<$aref> is reference to an array that has at least one element in it. Each element of the array is passed to subroutine I<$sub> which is assumed to be an assertion. For example: my $aref_of_counts = get_counts(); assert_arrayref_all( $aref, \&assert_positive_integer, 'Counts are positive' ); Whatever is passed as I<$name>, a string saying "Element #N" will be appended, where N is the zero-based index of the array. =cut sub assert_arrayref_all($$;$) { my $aref = shift; my $sub = shift; my $name = shift; my @why; assert_coderef( $sub, 'assert_arrayref_all requires a code reference' ); if ( ref($aref) eq 'ARRAY' || (Scalar::Util::blessed( $aref ) && $aref->isa( 'ARRAY' )) ) { if ( @{$aref} ) { my $inner_msg = defined($name) ? "$name: " : 'assert_arrayref_all: '; my $n = 0; for my $i ( @{$aref} ) { $sub->( $i, "${inner_msg}Element #$n" ); ++$n; } } else { push @why, 'Array contains no elements'; } } else { push @why, 'First argument to assert_arrayref_all was not an array'; } if ( @why ) { require Carp; &Carp::confess( _failure_msg($name), @why ); } return; } =head2 assert_aoh( $ref [, $name ] ) Verifies that C<$array> is an arrayref, and that every element is a hashref. The array C<$array> can be an empty arraref and the assertion will pass. =cut sub assert_aoh { my $ref = shift; my $name = shift; my $ok = 0; if ( ref($ref) eq 'ARRAY' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'ARRAY' )) ) { $ok = 1; for my $val ( @{$ref} ) { if ( not ( ref($val) eq 'HASH' || (Scalar::Util::blessed( $val) && $val->isa( 'HASH' )) ) ) { $ok = 0; last; } } } return if $ok; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_coderef( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to a closure. =cut sub assert_coderef($;$) { my $ref = shift; my $name = shift; if ( ref($ref) eq 'CODE' || (Scalar::Util::blessed( $ref ) && $ref->isa( 'CODE' )) ) { return; } require Carp; &Carp::confess( _failure_msg($name) ); } =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(); If the C<$name> argument is not passed, a default message of " must not be called in void context" is provided. =cut sub assert_context_nonvoid(;$) { my @caller = caller(1); return if defined($caller[5]); my $name = shift // "$caller[3] must not be called in void context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head2 assert_context_scalar( [$name] ) Verifies that the function currently being executed has been called in scalar context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_scalar(); return $important_value; } This call to C will pass: my $val = something(); but these will fail: something(); my @things = something(); If the C<$name> argument is not passed, a default message of " must be called in scalar context" is provided. =cut sub assert_context_scalar(;$) { my @caller = caller(1); my $wantarray = $caller[5]; return if defined($wantarray) && !$wantarray; my $name = shift // "$caller[3] must be called in scalar context"; require Carp; &Carp::confess( _failure_msg($name) ); } =head1 UTILITY ASSERTIONS =head2 assert_fail( [$name] ) Assertion that always fails. C is exactly the same as calling C, but it eliminates that case where you accidentally use C, which of course never fires. =cut sub assert_fail(;$) { require Carp; &Carp::confess( _failure_msg($_[0]) ); } # Can't call confess() here or the stack trace will be wrong. sub _failure_msg { my ($name, @why) = @_; my $msg = 'Assertion'; $msg .= " ($name)" if defined $name; $msg .= " failed!\n"; $msg .= "$_\n" for @why; return $msg; } =head1 COPYRIGHT & LICENSE Copyright 2005-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.4.0/META.yml0000644000101700007640000000143314571513714015202 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.4.0 x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Carp-Assert-More-2.4.0/META.json0000644000101700007640000000245314571513714015355 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.4.0", "x_serialization_backend" : "JSON::PP version 2.27400" }