X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FAnyDBM_File.t;h=b87d26a2ff112d4a797888e86d5adcaa20f9cc86;hb=8af3c3489f0c9ca8d37ebae27991ac4f34dfdb2f;hp=30b3c7ac141173ec3cf324b5c30ff258772e9cc6;hpb=b695f709e8a342e35e482b0437eb6cdacdc58b6b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/AnyDBM_File.t b/lib/AnyDBM_File.t index 30b3c7a..b87d26a 100755 --- a/lib/AnyDBM_File.t +++ b/lib/AnyDBM_File.t @@ -6,41 +6,44 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; - if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){ - print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n"; - exit 0; - } + require Test::More; import Test::More; + plan(tests, 12); } + require AnyDBM_File; use Fcntl; -print "1..12\n"; -$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' or $^O eq 'dos' or - $^O eq 'os2' or $^O eq 'mint'); +$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || + $^O eq 'NetWare' || $^O eq 'dos' || + $^O eq 'os2' || $^O eq 'mint' || + $^O eq 'cygwin'); unlink ; umask(0); -print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640) - ? "ok 1\n" : "not ok 1\n"); + +ok( tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640), "Tie"); $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { ($Dfile) = ; } -if ($Is_Dosish || $^O eq 'MacOS') { - print "ok 2 # Skipped: different file permission semantics\n"; -} -else { + +SKIP: +{ + skip( "different file permission semantics",1) + if ($Is_Dosish || $^O eq 'MacOS') ; ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); - print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); + ok(($mode & 0777) == ($^O eq 'vos' ? 0750 : 0640) , "File permissions"); } + while (($key,$value) = each(%h)) { $i++; } -print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n"); + +ok(!$i,"Hash created empty"); $h{'goner1'} = 'snork'; @@ -62,7 +65,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); +ok(tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640),"Re-tie hash"); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -90,7 +93,7 @@ delete $h{'goner3'}; @keys = keys(%h); @values = values(%h); -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} +ok( ($#keys == 29 && $#values == 29),'$#keys == $#values'); while (($key,$value) = each(%h)) { if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { @@ -99,10 +102,10 @@ while (($key,$value) = each(%h)) { } } -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} +ok($i == 30,"keys and values match"); @keys = ('blurfl', keys(%h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} +ok($#keys == 31,"Correct number of keys"); $h{'foo'} = ''; $h{''} = 'bar'; @@ -111,22 +114,21 @@ $h{''} = 'bar'; $ok = 1; for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); +ok($ok, "cache overflow and numeric keys and contents"); ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); +ok($size > 0, "check file size"); @h{0..200} = 200..400; @foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; +ok( join(':',200..400) eq join(':',@foo), "hash slice"); -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -if ($h{''} eq 'bar') { - print "ok 12\n" ; -} -else { - if ($AnyDBM_File::ISA[0] eq 'DB_File' && $DB_File::db_ver >= 2.004010) { +ok($h{'foo'} eq '', "empty value"); + +my $compact = ''; + +if ($AnyDBM_File::ISA[0] eq 'DB_File' && ($DB_File::db_ver >= 2.004010 && $DB_File::db_ver < 3.001)) { ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ; $major =~ s/^0+// ; $minor =~ s/^0+// ; @@ -138,16 +140,18 @@ else { # You are using DB_File $DB_File::VERSION and Berkeley DB $compact # # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys. - # This feature will be reenabled in a future version of Berkeley DB. + # This feature returned with version 3.1 # - print "ok 12 # skipped: db v$compact, no null key support\n" ; - } - else { - print "not ok 12\n" ; - } +} + +SKIP: +{ + skip( "db v$compact, no null key support", 1) if $compact; + ok($h{''} eq 'bar','null key'); } untie %h; + if ($^O eq 'VMS') { unlink 'Op_dbmx.sdbm_dir', $Dfile; } else {