Carp-Assert-More-1.20/0000755000101700007640000000000013523306672013646 5ustar alesterispcCarp-Assert-More-1.20/t/0000755000101700007640000000000013523306672014111 5ustar alesterispcCarp-Assert-More-1.20/t/assert_nonnegative_integer.t0000644000101700007640000000113213141144243021674 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_nonnegative_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_in.t0000644000101700007640000000236312737244634016276 0ustar alesterispc#!/usr/bin/perl use warnings; use strict; use Test::More tests => 9; 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 string fa6yyils 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-1.20/t/assert_like.t0000644000101700007640000000150612737244634016612 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-1.20/t/assert_defined.t0000644000101700007640000000065512737244634017270 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-1.20/t/test-coverage.t0000644000101700007640000000057113523306654017051 0ustar alesterispc#!perl -Tw use Test::More tests => 34; 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-1.20/t/assert_fail.t0000644000101700007640000000027113141144243016560 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-1.20/t/assert_integer.t0000644000101700007640000000121612737244634017321 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use Test::Exception; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; 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-1.20/t/assert_undefined.t0000644000101700007640000000076612737244634017636 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-1.20/t/assert_positive_integer.t0000644000101700007640000000115713141144243021230 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_positive_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } done_testing(); exit 0; Carp-Assert-More-1.20/t/00-load.t0000644000101700007640000000031512737244634015436 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-1.20/t/assert_nonzero_integer.t0000644000101700007640000000107513141144243021057 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_nonzero_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } Carp-Assert-More-1.20/t/assert_isa.t0000644000101700007640000000130113523304016016414 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 4; 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 { my $random = 2112; 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-1.20/t/assert_all_keys_in.t0000644000101700007640000000134513336613751020154 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 3; 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' ); done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_aoh.t0000644000101700007640000000231613514440316016422 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( $@, '' ); done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_nonnegative.t0000644000101700007640000000107412737244634020203 0ustar alesterispc#!perl -T use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 5, PASS ], [ 0, PASS ], [ 0.4, PASS ], [ -10, FAIL ], [ "dog", PASS ], [ "14.", PASS ], ); for my $case ( @cases ) { my ($val,$status) = @$case; my $desc = "Checking \"$val\""; eval { assert_nonnegative( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } Carp-Assert-More-1.20/t/assert_isnt.t0000644000101700007640000000134612737244634016645 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-1.20/t/assert_unlike.t0000644000101700007640000000155512737244634017161 0ustar alesterispc#!/usr/bin/perl use warnings; use strict; use Test::More tests => 6; 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' ); Carp-Assert-More-1.20/t/assert_nonblank.t0000644000101700007640000000146412737244634017473 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!/, 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-1.20/t/assert_isa_in.t0000644000101700007640000000375113514440316017121 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 13; 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'; subtest assert_isa_in => sub { plan tests => 8; 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" ); } }; done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_datetime.t0000644000101700007640000000131713523306654017455 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More; use Carp::Assert::More; my $rc = eval 'use DateTime; 1;'; if ( !$rc ) { plan skip_all => 'DateTime must be installed to test 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' ); done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_negative_integer.t0000644000101700007640000000115713141144243021170 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 7; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_negative_integer( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } done_testing(); exit 0; Carp-Assert-More-1.20/t/pod-coverage.t0000644000101700007640000000040312737244634016653 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-1.20/t/assert_arrayref.t0000644000101700007640000000202113141144243017453 0ustar alesterispc#!perl -Tw # This is cut & paste of assert_arrayref.t 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_arrayref( {} ); }; 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_arrayref( $ref ); }; like( $@, qr/Assertion.*failed/ ); # 3 is not a listref eval { assert_arrayref( 3 ); }; like( $@, qr/Assertion.*failed/ ); # [] is a listref eval { assert_arrayref( [] ); }; is( $@, '' ); # a ref to a list with stuff in it is a listref my @ary = ('foo', 'bar', 'baaz'); eval { assert_arrayref( \@ary ); }; is( $@, '' ); # sub {} is not a listref eval { assert_arrayref( sub {} ); }; like( $@, qr/Assertion.*failed/ ); # Foo->new->isa("ARRAY") returns true, so do we eval { assert_arrayref( Foo->new ); }; is( $@, '' ); done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_empty.t0000644000101700007640000000240413141144243017003 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 ], [ {} => PASS ], [ [] => PASS ], [ {foo=>1} => FAIL ], [ [1,2,3] => FAIL ], ); for my $case ( @cases ) { my ($val,$expected_status) = @$case; eval { assert_empty( $val ) }; $val = "undef" if !defined($val); my $desc = "Checking \"$val\""; if ( $expected_status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } throws_ok( sub { assert_empty( 27 ) }, qr/Not an array or hash reference/ ); 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!/ ); } Carp-Assert-More-1.20/t/assert_numeric.t0000644000101700007640000000141313444730425017317 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" ); } done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_nonzero.t0000644000101700007640000000111613523304213017335 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_nonzero( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_lacks.t0000644000101700007640000000112612737244634016761 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/ ); lives_ok( sub { assert_lacks( \%foo, [qw()] ) } ); Carp-Assert-More-1.20/t/assert_exists.t0000644000101700007640000000134313141144243017165 0ustar alesterispc#!perl -T use warnings; use strict; use Test::More tests => 7; 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/ ); 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-1.20/t/assert_nonref.t0000644000101700007640000000115613141144243017137 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/ ); done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_nonempty.t0000644000101700007640000000242612737244634017541 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 ) }; $val = "undef" if !defined($val); my $desc = "Checking \"$val\""; if ( $expected_status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } throws_ok( sub { assert_nonempty( 27 ) }, qr/Not an array or hash reference/ ); 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-1.20/t/pod.t0000644000101700007640000000036612737244634015072 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-1.20/t/assert_coderef.t0000644000101700007640000000173713141144243017264 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-1.20/t/assert_hashref.t0000644000101700007640000000144712737244634017312 0ustar alesterispc#!perl -Tw package Foo; sub new { my $class = shift; return bless {@_}, $class; } package main; use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; local $@; $@ = ''; # {} is a hashref eval { assert_hashref( {} ); }; is( $@, '' ); # a ref to a hash with stuff in it is a hashref my %hash = ( foo => 'foo', bar => 'bar' ); eval { assert_hashref( \%hash ); }; is( $@, '' ); # 3 is not a hashref eval { assert_hashref( 3 ); }; like( $@, qr/Assertion.*failed/ ); # [] is not a hashref eval { assert_hashref( [] ); }; like( $@, qr/Assertion.*failed/ ); # sub {} is not a hashref eval { assert_hashref( sub {} ); }; like( $@, qr/Assertion.*failed/ ); # Foo->new->isa("HASH") returns true, so do we eval { assert_hashref( Foo->new ); }; is( $@, '' ); Carp-Assert-More-1.20/t/assert_listref.t0000644000101700007640000000170512737244634017337 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-1.20/t/assert_positive.t0000644000101700007640000000112313141144243017504 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_positive( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, '', $desc ); } } done_testing(); exit 0; Carp-Assert-More-1.20/t/assert_negative.t0000644000101700007640000000106713141144243017453 0ustar alesterispc#!perl -Tw use warnings; use strict; use Test::More tests => 6; use Carp::Assert::More; use constant PASS => 1; use constant FAIL => 2; my @cases = ( [ 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\""; eval { assert_negative( $val ) }; if ( $status eq FAIL ) { like( $@, qr/Assertion.+failed/, $desc ); } else { is( $@, "", $desc ); } } Carp-Assert-More-1.20/t/assert_is.t0000644000101700007640000000123712737244634016302 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-1.20/INSTALL0000644000101700007640000000104012737244634014677 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 and Carp::Assert Carp-Assert-More-1.20/MANIFEST0000644000101700007640000000163413523306672015003 0ustar alesterispcChanges 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_coderef.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_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_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-1.20/Changes0000644000101700007640000000603313523306654015143 0ustar alesterispcRevision history for Perl extension Carp::Assert::More. 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-1.20/More.pm0000644000101700007640000004530213523306654015112 0ustar alesterispcpackage Carp::Assert::More; use warnings; use strict; use Exporter; use Carp::Assert; use vars qw( $VERSION @ISA @EXPORT ); sub _any(&;@); =head1 NAME Carp::Assert::More - convenience wrappers around Carp::Assert =head1 VERSION Version 1.20 =cut BEGIN { $VERSION = '1.20'; @ISA = qw(Exporter); @EXPORT = qw( assert_all_keys_in assert_aoh assert_arrayref assert_coderef assert_datetime assert_defined assert_empty assert_exists assert_fail assert_hashref assert_in assert_integer assert_is assert_isa assert_isa_in assert_isnt 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 ); } =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 set of wrappers around the L functions to make the habit of writing assertions even easier. Everything in here is effectively syntactic sugar. There's no technical reason to use assert_isa( $foo, 'HTML::Lint' ); instead of assert( defined $foo ); assert( ref($foo) eq 'HTML::Lint' ); other than readability and simplicity of the code. My intent here is to make common assertions easy so that we as programmers have no excuse to not use them. =head1 CAVEATS I haven't specifically done anything to make Carp::Assert::More be backwards compatible with anything besides Perl 5.6.1, much less back to 5.004. Perhaps someone with better testing resources in that area can help me out here. =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; # undef only matches undef return if !defined($string) && !defined($match); assert_defined( $string, $name ); assert_defined( $match, $name ); return if $string eq $match; require Carp; &Carp::confess( Carp::Assert::_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( Carp::Assert::_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; assert_nonref( $string, $name ); assert_isa( $regex, 'Regexp', $name ); return if $string =~ $regex; require Carp; &Carp::confess( Carp::Assert::_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); assert_nonref( $string, $name ); assert_isa( $regex, 'Regexp', $name ); return if $string !~ $regex; require Carp; &Carp::confess( Carp::Assert::_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( Carp::Assert::_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( Carp::Assert::_fail_msg($_[1]) ); } =head2 assert_nonblank( $this [, $name] ) Asserts that I<$this> is not blank and not a reference. =cut sub assert_nonblank($;$) { my $this = shift; my $name = shift; assert_nonref( $this, $name ); return if $this ne ""; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head1 NUMERIC ASSERTIONS =head2 assert_numeric( $n [, $name] ) Asserts that C<$n> looks like a number, according to C. =cut sub assert_numeric { my $n = shift; my $name = shift; require Scalar::Util; assert( Scalar::Util::looks_like_number( $n ), $name ); return; } =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; assert_nonref( $this, $name ); return if $this =~ /^-?\d+$/; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head2 assert_nonzero( $this [, $name ] ) Asserts that the numeric value of I<$this> is not zero. assert_nonzero( 0 ); # FAIL assert_nonzero( -14 ); # pass assert_nonzero( '14.' ); # pass Asserts that the numeric value of I<$this> is not zero. =cut sub assert_nonzero($;$) { my $this = shift; my $name = shift; no warnings; return if $this+0 != 0; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head2 assert_positive( $this [, $name ] ) Asserts that the numeric value of I<$this> is 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; no warnings; return if $this+0 > 0; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head2 assert_nonnegative( $this [, $name ] ) Asserts that the numeric value of I<$this> is greater than or equal to zero. Since non-numeric strings evaluate to zero, this means that any non-numeric string will pass. 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; no warnings; return if $this+0 >= 0; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head2 assert_negative( $this [, $name ] ) Asserts that the numeric value of I<$this> is 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 $this+0 < 0; require Carp; &Carp::confess( Carp::Assert::_fail_msg($name) ); } =head2 assert_nonzero_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is not zero, and that I<$this> is an integer. 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; assert_nonzero( $this, $name ); assert_integer( $this, $name ); } =head2 assert_positive_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is greater than zero, and that I<$this> is an integer. 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; assert_positive( $this, $name ); assert_integer( $this, $name ); } =head2 assert_nonnegative_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is not less than zero, and that I<$this> is an integer. assert_nonnegative_integer( 0 ); # pass assert_nonnegative_integer( -14 ); # pass assert_nonnegative_integer( '14.' ); # FAIL =cut sub assert_nonnegative_integer($;$) { my $this = shift; my $name = shift; assert_nonnegative( $this, $name ); assert_integer( $this, $name ); } =head2 assert_negative_integer( $this [, $name ] ) Asserts that the numeric value of I<$this> is less than zero, and that I<$this> is an integer. 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; assert_negative( $this, $name ); assert_integer( $this, $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; assert_defined( $this, $name ); # 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. require Scalar::Util; return if Scalar::Util::blessed( $this ) && $this->isa( $type ); return if ref($this) eq $type; require Carp; &Carp::confess( Carp::Assert::_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; require Scalar::Util; my $ok = _any { Scalar::Util::blessed($obj) && $obj->isa($_) } @{$types}; assert( $ok, $name ); return; } =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; require Scalar::Util; my $underlying_type; if ( Scalar::Util::blessed( $ref ) ) { $underlying_type = Scalar::Util::reftype( $ref ); } else { $underlying_type = ref( $ref ); } if ( $underlying_type eq 'HASH' ) { assert_is( scalar keys %{$ref}, 0, $name ); } elsif ( $underlying_type eq 'ARRAY' ) { assert_is( scalar @{$ref}, 0, $name ); } else { assert_fail( 'Not an array or hash reference' ); } } =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; require Scalar::Util; my $underlying_type; if ( Scalar::Util::blessed( $ref ) ) { $underlying_type = Scalar::Util::reftype( $ref ); } else { $underlying_type = ref( $ref ); } if ( $underlying_type eq 'HASH' ) { assert_positive( scalar keys %{$ref}, $name ); } elsif ( $underlying_type eq 'ARRAY' ) { assert_positive( scalar @{$ref}, $name ); } else { assert_fail( 'Not an array or hash reference' ); } } =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( Carp::Assert::_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; return assert_isa( $ref, 'HASH', $name ); } =head2 assert_arrayref( $ref [, $name] ) =head2 assert_listref( $ref [,$name] ) Asserts that I<$ref> is defined, and is a reference to a (possibly empty) list. 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; return assert_isa( $ref, 'ARRAY', $name ); } *assert_listref = *assert_arrayref; =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 $array = shift; my $msg = shift; $msg = 'Is an array of hashes' unless defined($msg); assert_arrayref( $array, "$msg: Is an array" ); my $i = 0; for my $val ( @{$array} ) { assert_hashref( $val, "$msg: Element $i is a hash" ); ++$i; } return; } =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; return assert_isa( $ref, 'CODE', $name ); } =head1 TYPE-SPECIFIC ASSERTIONS =head2 assert_datetime( $date ) Asserts that C<$date> is a DateTime object. =cut sub assert_datetime { my $datetime = shift; my $desc = shift // 'Must be a DateTime object'; assert_isa( $datetime, 'DateTime', $desc ); return; } =head1 SET AND HASH MEMBERSHIP =head2 assert_in( $string, \@inlist [,$name] ); Asserts that I<$string> is defined and matches one of the elements of I<\@inlist>. I<\@inlist> must be an array reference of defined strings. =cut sub assert_in($$;$) { my $string = shift; my $arrayref = shift; my $name = shift; assert_nonref( $string, $name ); assert_isa( $arrayref, 'ARRAY', $name ); foreach my $element (@{$arrayref}) { assert_nonref( $element, $name ); return if $string eq $element; } require Carp; &Carp::confess( Carp::Assert::_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; assert_isa( $hash, 'HASH', $name ); my @list = ref($key) ? @$key : ($key); for ( @list ) { if ( !exists( $hash->{$_} ) ) { require Carp; &Carp::confess( Carp::Assert::_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>. 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; assert_isa( $hash, 'HASH', $name ); my @list = ref($key) ? @$key : ($key); for ( @list ) { if ( exists( $hash->{$_} ) ) { require Carp; &Carp::confess( Carp::Assert::_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' ); =cut sub assert_all_keys_in { my $hash = shift; my $valid_keys = shift; my $name = shift; assert_hashref( $hash ); assert_listref( $valid_keys ); foreach my $key ( keys %{$hash} ) { assert_in( $key, $valid_keys, $name ); } return; } =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( Carp::Assert::_fail_msg($_[0]) ); } # Since List::Util doesn't have any() all the way back. sub _any(&;@) { my $sub = shift; $sub->($_) && return 1 for @_; return 0; } =head1 COPYRIGHT & LICENSE Copyright 2005-2019 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 "I stood on the porch in a tie." Carp-Assert-More-1.20/Makefile.PL0000644000101700007640000000252513141144243015612 0ustar alesterispcpackage main; use 5.006001; 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, 'Carp::Assert' => 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://rt.cpan.org/Public/Dist/Display.html?Name=Carp-Assert-More', repository => 'https://github.com/petdance/carp-assert-more/tree/master', license => 'http://www.opensource.org/licenses/artistic-license-2.0.php', } }; } WriteMakefile( %parms ); package MY; sub MY::postamble { my $postamble = <<'MAKE_FRAG'; .PHONY: critic critic: perlcritic -1 -q -profile perlcriticrc More.pm t/*.t MAKE_FRAG return $postamble; } 1; Carp-Assert-More-1.20/README.md0000644000101700007640000000065713141144243015123 0ustar alesterispc# Carp::Assert::More [![Build Status](https://travis-ci.org/petdance/carp-assert-more.svg?branch=dev)](https://travis-ci.org/petdance/carp-assert-more) Carp::Assert::More is a set of handy assertion functions for Perl. For example, instead of writing assert( defined($foo), '$foo cannot be undefined' ); assert( $foo ne '', '$foo cannot be blank' ); you can write assert_nonblank( $foo, '$foo cannot be blank' ); Carp-Assert-More-1.20/META.yml0000644000101700007640000000147413523306672015125 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.16, CPAN::Meta::Converter version 2.150005' 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' Carp::Assert: '0' Scalar::Util: '0' Test::Exception: '0' Test::More: '0.18' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Carp-Assert-More license: http://www.opensource.org/licenses/artistic-license-2.0.php repository: https://github.com/petdance/carp-assert-more/tree/master version: '1.20' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Carp-Assert-More-1.20/META.json0000644000101700007640000000254513523306672015275 0ustar alesterispc{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.16, CPAN::Meta::Converter version 2.150005", "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", "Carp::Assert" : "0", "Scalar::Util" : "0", "Test::Exception" : "0", "Test::More" : "0.18" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Carp-Assert-More" }, "license" : [ "http://www.opensource.org/licenses/artistic-license-2.0.php" ], "repository" : { "url" : "https://github.com/petdance/carp-assert-more/tree/master" } }, "version" : "1.20", "x_serialization_backend" : "JSON::PP version 2.27400" }