X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=t%2Fkdb.t;h=ccaeda339a2e78eb301fc17c4a4a43081064d8ff;hb=8e4a00010331fe5243c9550a7adce09e9e044a23;hp=ab4fea47818f838394d3a9fef6826b3280583add;hpb=f63182fc62b25269b1c38588dca2b3535ed1a1a2;p=chaz%2Fp5-File-KDBX diff --git a/t/kdb.t b/t/kdb.t index ab4fea4..ccaeda3 100644 --- a/t/kdb.t +++ b/t/kdb.t @@ -9,7 +9,7 @@ use TestCommon; use Encode qw(decode); use File::KDBX; use Test::Deep; -use Test::More; +use Test::More 1.001004_001; eval { require File::KeePass; require File::KeePass::KDBX } or plan skip_all => 'File::KeePass and File::KeePass::KDBX required to test KDB files'; @@ -27,8 +27,8 @@ sub test_basic { transform_seed => "\227\264\n^\230\2\301:!f\364\336\251\277\241[\3`\314RG\343\16U\333\305eT3:\240\257", }), 'Get expected headers from KDB file' or diag explain $kdbx->headers; - is keys %{$kdbx->deleted_objects}, 0, 'There are no deleted objects'; - is scalar @{$kdbx->root->groups}, 2, 'Root group has two children.'; + is keys %{$kdbx->deleted_objects}, 0, 'There are no deleted objects' or dumper $kdbx->deleted_objects; + is scalar @{$kdbx->root->groups}, 2, 'Root group has two children'; my $group1 = $kdbx->root->groups->[0]; isnt $group1->uuid, undef, 'Group 1 has a UUID'; @@ -92,18 +92,19 @@ for my $test ( sub test_custom_icons { my $kdbx = shift; + $kdbx = $kdbx->() if ref $kdbx eq 'CODE'; - my ($uuid, @other) = keys %{$kdbx->custom_icons}; - ok $uuid, 'Database has a custom icon'; + my ($icon, @other) = @{$kdbx->custom_icons}; + ok $icon, 'Database has a custom icon'; is scalar @other, 0, 'Database has no other icons'; - my $data = $kdbx->custom_icon_data($uuid); - like $data, qr/^\x89PNG\r\n/, 'Custom icon is a PNG'; + like $icon->{data}, qr/^\x89PNG\r\n/, 'Custom icon is a PNG'; } for my $test ( ['Custom icons' => $kdbx], - ['Custom icons after dump & load roundtrip' - => File::KDBX->load_string($kdbx->dump_string('a', upgrade => 0, randomize_seeds => 0), 'a')], + ['Custom icons after dump & load roundtrip' => sub { + File::KDBX->load_string($kdbx->dump_string('a', allow_upgrade => 0, randomize_seeds => 0), 'a'); + }], ) { my ($name, $kdbx) = @$test; subtest $name, \&test_custom_icons, $kdbx;