Fix label on C<for(;;)> statement

[p5sagit/p5-mst-13.2.git] / t / lib / db-recno.t

diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 9a2695b..5df5af1 100755 (executable)
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -1,7 +1,7 @@
 #!./perl -w
 
 BEGIN {
-    @INC = '../lib';
+    @INC = '../lib' if -d '../lib' ;
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bDB_File\b/) {
        print "1..0\n";
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 use strict ;
-use vars qw($dbh $Dfile) ;
+use vars qw($dbh $Dfile $bad_ones) ;
 
 sub ok
 {
@@ -21,9 +21,27 @@ sub ok
 
     print "not " unless $result ;
     print "ok $no\n" ;
+
+    return $result ;
+}
+
+sub bad_one
+{
+    print STDERR <<EOM unless $bad_ones++ ;
+#
+# Some older versions of Berkeley DB will fail tests 51, 53 and 55.
+#
+# You can safely ignore the errors if you're never going to use the
+# broken functionality (recno databases with a modified bval). 
+# Otherwise you'll have to upgrade your DB library.
+#
+# If you want to upgrade Berkeley DB, the most recent version is 1.85.
+# Check out http://www.bostic.com/db for more details.
+#
+EOM
 }
 
-print "1..47\n";
+print "1..55\n";
 
 my $Dfile = "recno.tmp";
 unlink $Dfile ;
@@ -33,15 +51,13 @@ umask(0);
 # Check the interface to RECNOINFO
 
 my $dbh = new DB_File::RECNOINFO ;
-$^W = 0 ;
-ok(1, $dbh->{bval} == undef ) ;
-ok(2, $dbh->{cachesize} == undef) ;
-ok(3, $dbh->{psize} == undef) ;
-ok(4, $dbh->{flags} == undef) ;
-ok(5, $dbh->{lorder} == undef);
-ok(6, $dbh->{reclen} == undef);
-ok(7, $dbh->{bfname} eq undef);
-$^W = 0 ;
+ok(1, ! defined $dbh->{bval}) ;
+ok(2, ! defined $dbh->{cachesize}) ;
+ok(3, ! defined $dbh->{psize}) ;
+ok(4, ! defined $dbh->{flags}) ;
+ok(5, ! defined $dbh->{lorder}) ;
+ok(6, ! defined $dbh->{reclen}) ;
+ok(7, ! defined $dbh->{bfname}) ;
 
 $dbh->{bval} = 3000 ;
 ok(8, $dbh->{bval} == 3000 );
@@ -77,7 +93,8 @@ my $X  ;
 my @h ;
 ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
 
-ok(18, ( (stat($Dfile))[2] & 0777) == 0640) ;
+ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
+       || $^O eq 'amigaos') ;
 
 #my $l = @h ;
 my $l = $X->length ;
@@ -181,4 +198,76 @@ untie(@h);
 
 unlink $Dfile;
 
+{
+    # Check bval defaults to \n
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    ok(48, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = `cat $Dfile` ;
+    unlink $Dfile;
+    ok(49, $x eq "abc\ndef\n\nghi\n") ;
+}
+
+{
+    # Change bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{bval} = "-" ;
+    ok(50, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = `cat $Dfile` ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc-def--ghi-") ;
+    bad_one() unless $ok ;
+    ok(51, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with default bval (space)
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{reclen} = 5 ;
+    ok(52, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = `cat $Dfile` ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc  def       ghi  ") ;
+    bad_one() unless $ok ;
+    ok(53, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with user-defined bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{bval} = "-" ;
+    $dbh->{reclen} = 5 ;
+    ok(54, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = `cat $Dfile` ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc--def-------ghi--") ;
+    bad_one() unless $ok ;
+    ok(55, $ok) ;
+}
+
 exit ;