Carp-Assert-More-2.0.1/0000755000175100017510000000000014105522370013207 5ustar andyandyCarp-Assert-More-2.0.1/t/0000755000175100017510000000000014105522370013452 5ustar andyandyCarp-Assert-More-2.0.1/t/assert_lacks.t0000644000175100017510000000115614105474520016323 0ustar andyandy#!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.0.1/t/assert_numeric.t0000644000175100017510000000137314105474520016671 0ustar andyandy#!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.0.1/t/assert_nonref.t0000644000175100017510000000113614105474520016513 0ustar andyandy#!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.0.1/t/assert_hashref_nonempty.t0000644000175100017510000000225113771554400020600 0ustar andyandy#!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.0.1/t/assert_keys_are.t0000644000175100017510000000304313737230375017035 0ustar andyandy#!perl -Tw use warnings; use strict; use Test::More tests => 1; use Carp::Assert::More; use Test::Exception; subtest assert_keys_are => sub { plan tests => 8; 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/Assertion.*failed!/, 'Monolith fails on person keys' ); throws_ok( sub { assert_keys_are( $monolith, [@object_keys[0..1]] ) }, qr/Assertion.*failed/, 'Hash has too many keys' ); throws_ok( sub { assert_keys_are( $monolith, [@object_keys, 'wavelength'] ) }, qr/Assertion.*failed/, 'Hash has one key too many' ); throws_ok( sub { assert_keys_are( $monolith, [] ) }, qr/Assertion.*failed/, 'Empty key list fails for non-empty object' ); throws_ok( sub { assert_keys_are( {}, \@object_keys ) }, qr/Assertion.*failed/, 'Empty hash fails for non-empty key list' ); }; exit 0; Carp-Assert-More-2.0.1/t/assert_negative_integer.t0000644000175100017510000000132014105474520020536 0ustar andyandy#!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.0.1/t/assert_unlike.t0000644000175100017510000000173214105474520016515 0ustar andyandy#!/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.0.1/t/assert_integer.t0000644000175100017510000000137314105474520016664 0ustar andyandy#!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.0.1/t/assert_context_scalar.t0000644000175100017510000000123414105474520020234 0ustar andyandy#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 3; use Carp::Assert::More; sub important_function { assert_context_scalar( 'important_function must be called in scalar context' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (important_function must be called in scalar context) failed!/ ); # Call in list context. eval { my @x = important_function(); }; like( $@, qr/\QAssertion (important_function must be called in scalar context) failed!/ ); exit 0; Carp-Assert-More-2.0.1/t/assert_context_nonvoid.t0000644000175100017510000000113214105474520020440 0ustar andyandy#!perl -Tw use warnings; use strict; use 5.010; use Test::More tests => 3; use Carp::Assert::More; sub important_function { assert_context_nonvoid( 'important_function must not be called in void context' ); return 2112; } local $@; $@ = ''; # Keep the value returned. eval { my $x = important_function(); }; is( $@, '' ); # Keep the value in an array. eval { my @x = important_function(); }; is( $@, '' ); # Ignore the value returned. eval { important_function(); }; like( $@, qr/\QAssertion (important_function must not be called in void context) failed!/ ); exit 0; Carp-Assert-More-2.0.1/t/assert_undefined.t0000644000175100017510000000076613736754571017215 0ustar andyandy#!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.0.1/t/assert_positive.t0000644000175100017510000000126214105474520017066 0ustar andyandy#!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.0.1/t/assert_nonempty.t0000644000175100017510000000241114105474520017072 0ustar andyandy#!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!/ ); } BLESSED_ARRAY: { my $array_object = bless( [], 'WackyPackage' ); throws_ok( sub { assert_nonempty( $array_object, 'Flooble' ) }, qr/\QAssertion (Flooble) failed!/ ); 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!/ ); $hash_object->{foo} = 14; lives_ok( sub { assert_nonempty( $hash_object ) } ); } Carp-Assert-More-2.0.1/t/assert_aoh.t0000644000175100017510000000227614105474520016001 0ustar andyandy#!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.0.1/t/assert_negative.t0000644000175100017510000000125014105474520017023 0ustar andyandy#!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.0.1/t/assert_empty.t0000644000175100017510000000240114105474520016356 0ustar andyandy#!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 ], [ {} => 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_empty( 27 ) }, qr/Assertion failed!/ ); } 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!/ ); } 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!/ ); } exit 0; Carp-Assert-More-2.0.1/t/assert_listref.t0000644000175100017510000000170513736754571016716 0ustar andyandy#!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.0.1/t/assert_coderef.t0000644000175100017510000000173713736754571016662 0ustar andyandy#!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.0.1/t/pod-coverage.t0000644000175100017510000000040313736754571016232 0ustar andyandy#!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.0.1/t/assert_is.t0000644000175100017510000000123713771550420015643 0ustar andyandy#!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.0.1/t/00-load.t0000644000175100017510000000031513736754571015015 0ustar andyandy#!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.0.1/t/assert_in.t0000644000175100017510000000310514105474520015630 0ustar andyandy#!/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.0.1/t/assert_exists.t0000644000175100017510000000211614105474520016542 0ustar andyandy#!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.0.1/t/pod.t0000644000175100017510000000036613736754571014451 0ustar andyandy#!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.0.1/t/assert_all_keys_in.t0000644000175100017510000000165614105522217017521 0ustar andyandy#!perl -Tw use warnings; use strict; use Test::More tests => 5; use Carp::Assert::More; use Test::Exception; 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_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/Assertion.*failed!/, 'Monolith fails on person keys' ); throws_ok( sub { assert_all_keys_in( $monolith, [] ) }, qr/Assertion.*failed!/, 'Monolith fails on empty list of keys' ); lives_ok( sub { assert_all_keys_in( {}, [] ) }, 'Empty hash and empty keys' ); exit 0; Carp-Assert-More-2.0.1/t/assert_datetime.t0000644000175100017510000000134614105474520017023 0ustar andyandy#!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.0.1/t/assert_nonnegative_integer.t0000644000175100017510000000127314105474520021260 0ustar andyandy#!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.0.1/t/assert_arrayref_nonempty.t0000644000175100017510000000252614105474520020774 0ustar andyandy#!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.0.1/t/assert_fail.t0000644000175100017510000000027113736754571016156 0ustar andyandy#!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.0.1/t/assert_isnt.t0000644000175100017510000000134613771550420016206 0ustar andyandy#!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.0.1/t/assert_nonzero_integer.t0000644000175100017510000000125614105474520020436 0ustar andyandy#!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.0.1/t/assert_nonnegative.t0000644000175100017510000000125114105474520017537 0ustar andyandy#!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.0.1/t/assert_positive_integer.t0000644000175100017510000000141114105474520020577 0ustar andyandy#!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.0.1/t/assert_nonblank.t0000644000175100017510000000146413736754571017052 0ustar andyandy#!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!/, q{'' is blank, with no message} ); throws_ok( sub { assert_nonblank( '', 'flooble' ) }, qr/\QAssertion (flooble) failed!/, q{'' is blank, with message} ); throws_ok( sub { assert_nonblank( undef ) }, qr/Assertion failed!/, q{undef is blank, with no message} ); throws_ok( sub { assert_nonblank( undef, 'bargle' ) }, qr/\QAssertion (bargle) failed!/, q{undef is blank, with message} ); throws_ok( sub { my $scalar = "Blah blah"; my $ref = \$scalar; assert_nonblank( $ref, 'wango' ); }, qr/\QAssertion (wango) failed!/, 'Testing scalar ref' ); Carp-Assert-More-2.0.1/t/assert_nonzero.t0000644000175100017510000000125714105474520016722 0ustar andyandy#!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.0.1/t/assert_arrayref.t0000644000175100017510000000166114105474520017042 0ustar andyandy#!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.0.1/t/test-coverage.t0000644000175100017510000000057114105474520016415 0ustar andyandy#!perl -Tw use Test::More tests => 39; 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.0.1/t/assert_isa.t0000644000175100017510000000160114105474520015775 0ustar andyandy#!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.0.1/t/assert_like.t0000644000175100017510000000150613736754571016171 0ustar andyandy#!/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.0.1/t/assert_defined.t0000644000175100017510000000065513736754571016647 0ustar andyandy#!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.0.1/t/assert_hashref.t0000644000175100017510000000156213771554400016653 0ustar andyandy#!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.0.1/t/assert_isa_in.t0000644000175100017510000000366514105474520016477 0ustar andyandy#!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.0.1/Changes0000644000175100017510000001164314105522264014511 0ustar andyandyRevision history for Perl extension Carp::Assert::More. 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.0.1/MANIFEST0000644000175100017510000000204714105522370014343 0ustar andyandyChanges cpanfile INSTALL MANIFEST Makefile.PL More.pm README.md t/00-load.t t/assert_all_keys_in.t t/assert_aoh.t t/assert_arrayref.t t/assert_arrayref_nonempty.t t/assert_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.0.1/cpanfile0000644000175100017510000000043514105474520014720 0ustar andyandy# 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.0.1/README.md0000644000175100017510000002542314105474520014477 0ustar andyandy# 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.0.1/INSTALL0000644000175100017510000000106014105474520014240 0ustar andyandyWHAT 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.0.1/More.pm0000644000175100017510000006120514105522217014453 0ustar andyandypackage Carp::Assert::More; use warnings; use strict; use Exporter; use Scalar::Util; use vars qw( $VERSION @ISA @EXPORT ); =head1 NAME Carp::Assert::More - Convenience assertions for common situations =head1 VERSION Version 2.0.1 =cut BEGIN { $VERSION = '2.0.1'; @ISA = qw(Exporter); @EXPORT = qw( assert_all_keys_in assert_aoh assert_arrayref assert_arrayref_nonempty 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> matches I<$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( _fail_msg($name) ); } =head2 assert_isnt( $string, $unmatch [,$name] ) Asserts that I<$string> does NOT match I<$unmatch>. =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( _fail_msg($name) ); } =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( _fail_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( _fail_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( _fail_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( _fail_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; if ( defined($this) && !ref($this) ) { return if $this ne ''; } require Carp; &Carp::confess( _fail_msg($name) ); } =head1 NUMERIC ASSERTIONS =head2 assert_numeric( $n [, $name] ) Asserts that C<$n> looks like a number, according to C. C will always fail. =cut sub assert_numeric { my $n = shift; my $name = shift; return if Scalar::Util::looks_like_number( $n ); require Carp; &Carp::confess( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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 ); } if ( $underlying_type eq 'HASH' ) { return if scalar keys %{$ref} == 0; } elsif ( $underlying_type eq 'ARRAY' ) { return if @{$ref} == 0; } require Carp; &Carp::confess( _fail_msg($name) ); } =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 ); } if ( $underlying_type eq 'HASH' ) { return if scalar keys %{$ref} > 0; } elsif ( $underlying_type eq 'ARRAY' ) { return if scalar @{$ref} > 0; } require Carp; &Carp::confess( _fail_msg($name) ); } =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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_msg($name) ); } =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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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( _fail_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 $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; last; } } } } return if $ok; require Carp; &Carp::confess( _fail_msg($name) ); } =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 $ok = 0; if ( ref($hash) eq 'HASH' || (Scalar::Util::blessed( $hash ) && $hash->isa( 'HASH' )) ) { if ( ref($keys) eq 'ARRAY' ) { my %keys = map { $_ => 1 } @{$keys}; my @hashkeys = keys %{$hash}; if ( scalar @hashkeys == scalar keys %keys ) { $ok = 1; for my $key ( @hashkeys ) { if ( !exists $keys{$key} ) { $ok = 0; last; } } } } } return if $ok; require Carp; &Carp::confess( _fail_msg($name) ); } =head1 CONTEXT ASSERTIONS =head2 assert_context_nonvoid( [$name] ) Verifies that the function currently being executed has not been called in void context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_scalar(); return $important_value; } These calls to C will pass: my $val = something(); my @things = something(); but this will fail: something(); =cut sub assert_context_nonvoid(;$) { my $name = shift; my $wantarray = (caller(1))[5]; return if defined($wantarray); require Carp; &Carp::confess( _fail_msg($name) ); } =head2 assert_context_scalar( [$name] ) Verifies that the function currently being executed has been called in scalar context. This is to ensure the calling function is not ignoring the return value of the executing function. Given this function: sub something { ... assert_context_scalar(); return $important_value; } This call to C will pass: my $val = something(); but these will fail: something(); my @things = something(); =cut sub assert_context_scalar(;$) { my $name = shift; my $wantarray = (caller(1))[5]; return if defined($wantarray) && !$wantarray; require Carp; &Carp::confess( _fail_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( _fail_msg($_[0]) ); } # Can't call confess() here or the stack trace will be wrong. sub _fail_msg { my($name) = shift; my $msg = 'Assertion'; $msg .= " ($name)" if defined $name; $msg .= " failed!\n"; return $msg; } =head1 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. =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.0.1/Makefile.PL0000644000175100017510000000264414105474520015172 0ustar andyandypackage main; use 5.10.0; use strict; use warnings; use ExtUtils::MakeMaker; my %parms = ( NAME => 'Carp::Assert::More', VERSION_FROM => 'More.pm', # finds $VERSION 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', }, ); if ( $ExtUtils::MakeMaker::VERSION =~ /^\d\.\d\d$/ and $ExtUtils::MakeMaker::VERSION > 6.30 ) { $parms{LICENSE} = 'artistic_2'; } if ( $ExtUtils::MakeMaker::VERSION ge '6.46' ) { $parms{META_MERGE} = { resources => { 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.0.1/META.yml0000664000175100017510000000122514105522370014462 0ustar andyandy--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.143240' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Carp-Assert-More no_index: directory: - t - inc requires: Carp: '0' Scalar::Util: '0' Test::Exception: '0' Test::More: '0.18' resources: bugtracker: https://github.com/petdance/carp-assert-more/issues license: https://opensource.org/licenses/artistic-license-2.0.php version: v2.0.1 Carp-Assert-More-2.0.1/META.json0000664000175100017510000000221414105522370014631 0ustar andyandy{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.143240", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Carp-Assert-More", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Scalar::Util" : "0", "Test::Exception" : "0", "Test::More" : "0.18" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/petdance/carp-assert-more/issues" }, "license" : [ "https://opensource.org/licenses/artistic-license-2.0.php" ] }, "version" : "v2.0.1" }