1#!perl -Tw 2 3use warnings; 4use strict; 5 6use Test::More tests => 1; 7 8use Carp::Assert::More; 9 10use Test::Exception; 11 12subtest assert_keys_are => sub { 13 plan tests => 8; 14 15 my $monolith = { 16 depth => 1, 17 width => 4, 18 height => 9, 19 }; 20 my $shaq = { 21 firstname => 'Shaquille', 22 lastname => 'O\'Neal', 23 height => 85, 24 }; 25 26 my @object_keys = qw( height width depth ); 27 my @person_keys = qw( firstname lastname height ); 28 29 lives_ok( sub { assert_keys_are( $monolith, \@object_keys ) }, 'Monolith object has valid keys' ); 30 lives_ok( sub { assert_keys_are( $shaq, \@person_keys ) }, 'Shaq object has valid keys' ); 31 lives_ok( sub { assert_keys_are( {}, [] ) }, 'Empty hash + empty keys works fine' ); 32 33 throws_ok( 34 sub { assert_keys_are( $monolith, \@person_keys ) }, 35 qr/Assertion.*failed!/, 36 'Monolith fails on person keys' 37 ); 38 39 throws_ok( 40 sub { assert_keys_are( $monolith, [@object_keys[0..1]] ) }, 41 qr/Assertion.*failed/, 42 'Hash has too many keys' 43 ); 44 throws_ok( 45 sub { assert_keys_are( $monolith, [@object_keys, 'wavelength'] ) }, 46 qr/Assertion.*failed/, 47 'Hash has one key too many' 48 ); 49 throws_ok( 50 sub { assert_keys_are( $monolith, [] ) }, 51 qr/Assertion.*failed/, 52 'Empty key list fails for non-empty object' 53 ); 54 throws_ok( 55 sub { assert_keys_are( {}, \@object_keys ) }, 56 qr/Assertion.*failed/, 57 'Empty hash fails for non-empty key list' 58 ); 59}; 60 61exit 0; 62