RE: DB_File-1.79 on Cygwin 1.3.3

Message-ID: <AIEAJICLCBDNAAOLLOKLGEJGDDAA.Paul_Marquess@Yahoo.co.uk>

p4raw-id: //depot/perl@12770

diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t
index 529a600..eebbf86 100755 (executable)
--- a/ext/DB_File/t/db-btree.t
+++ b/ext/DB_File/t/db-btree.t
@@ -1,17 +1,26 @@
 #!./perl -w
 
+use warnings;
+use strict;
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib' if -d '../lib';
+    }
+}
+ 
+use Config;
+ 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
+            print "1..163\n";
+            exit 0;
+        }
     }
 }
 
-use warnings;
-use strict;
 use DB_File; 
 use Fcntl;
 
@@ -66,24 +75,32 @@ sub lexical
 sub docat
 { 
     my $file = shift;
-    #local $/ = undef unless wantarray ;
+    local $/ = undef ;
     open(CAT,$file) || die "Cannot open $file: $!";
-    my @result = <CAT>;
+    my $result = <CAT>;
     close(CAT);
-    wantarray ? @result : join("", @result) ;
+    $result = normalise($result) ;
+    return $result ;
 }   
 
 sub docat_del
 { 
     my $file = shift;
-    #local $/ = undef unless wantarray ;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my @result = <CAT>;
-    close(CAT);
+    my $result = docat($file);
     unlink $file ;
-    wantarray ? @result : join("", @result) ;
+    return $result ;
 }   
 
+sub normalise
+{
+    my $data = shift ;
+    $data =~ s#\r\n#\n#g 
+        if $^O eq 'cygwin' ;
+
+    return $data ;
+}
+
+
 
 my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
 my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
@@ -143,8 +160,11 @@ ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
+
+my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
+
 ok(20, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640)
-   || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'NetWare');
+   || $noMode{$^O} );
 
 my ($key, $value, $i);
 while (($key,$value) = each(%h)) {

diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t
index bd6fb58..f23c5f2 100755 (executable)
--- a/ext/DB_File/t/db-hash.t
+++ b/ext/DB_File/t/db-hash.t
@@ -1,12 +1,23 @@
-#!./perl -w
+#!./perl 
+
+use warnings ;
+use strict ;
 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib' if -d '../lib';
+    }
+}
+ 
+use Config;
+ 
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
+            print "1..111\n";
+            exit 0;
+        }
     }
 }
 
@@ -55,10 +66,21 @@ sub docat_del
     open(CAT,$file) || die "Cannot open $file: $!";
     my $result = <CAT>;
     close(CAT);
+    $result = normalise($result) ;
     unlink $file ;
     return $result;
 }   
 
+sub normalise
+{
+    my $data = shift ;
+    $data =~ s#\r\n#\n#g 
+        if $^O eq 'cygwin' ;
+    return $data ;
+}
+
+
+
 my $Dfile = "dbhash.tmp";
 my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
                                || $DB_File::db_ver >= 3.1 );
@@ -109,8 +131,11 @@ ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
    $blksize,$blocks) = stat($Dfile);
+
+my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
+
 ok(16, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640) ||
-   $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'NetWare');
+   $noMode{$^O} );
 
 my ($key, $value, $i);
 while (($key,$value) = each(%h)) {

diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
index 24ee17c..8090d48 100755 (executable)
--- a/ext/DB_File/t/db-recno.t
+++ b/ext/DB_File/t/db-recno.t
@@ -1,19 +1,28 @@
 #!./perl -w
 
+use warnings;
+use strict ;
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib' if -d '../lib';
+    }
+}
+ 
+use Config;
+ 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
-    require Config; import Config;
-    if ($Config{'extensions'} !~ /\bDB_File\b/) {
-       print "1..0 # Skip: DB_File was not built\n";
-       exit 0;
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
+            print "1..138\n";
+            exit 0;
+        }
     }
 }
 
 use DB_File; 
 use Fcntl;
-use strict ;
-use warnings;
 use vars qw($dbh $Dfile $bad_ones $FA) ;
 
 # full tied array support started in Perl 5.004_57
@@ -69,16 +78,14 @@ sub docat
     open(CAT,$file) || die "Cannot open $file:$!";
     my $result = <CAT>;
     close(CAT);
+    normalise($result) ;
     return $result;
 }
 
 sub docat_del
 { 
     my $file = shift;
-    local $/ = undef;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my $result = <CAT>;
-    close(CAT);
+    my $result = docat($file);
     unlink $file ;
     return $result;
 }   
@@ -101,6 +108,25 @@ sub bad_one
 EOM
 }
 
+sub normalise
+{
+    return unless $^O eq 'cygwin' ;
+    foreach (@_)
+      { s#\r\n#\n#g }     
+}
+
+BEGIN 
+{ 
+    { 
+        local $SIG{__DIE__} ; 
+        eval { require Data::Dumper ; import Data::Dumper } ; 
+    }
+ 
+    if ($@) {
+        *Dumper = sub { my $a = shift; return "[ @{ $a } ]" } ;
+    }          
+}
+
 my $splice_tests = 10 + 1; # ten regressions, plus the randoms
 my $total_tests = 138 ;
 $total_tests += $splice_tests if $FA ;
@@ -156,8 +182,10 @@ my $X  ;
 my @h ;
 ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
 
+my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
+
 ok(18, ((stat($Dfile))[2] & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640)
-       ||  $^O eq 'MSWin32' ||  $^O eq 'NetWare' || $^O eq 'cygwin' || $^O eq 'amigaos') ;
+       ||  $noMode{$^O} );
 
 #my $l = @h ;
 my $l = $X->length ;
@@ -288,8 +316,7 @@ unlink $Dfile;
     untie @h ;
     my $x = docat($Dfile) ;
     unlink $Dfile;
-    ok(59, $x eq "abc\ndef\n\nghi\n" ||
-           $x eq "abc\r\ndef\r\n\r\nghi\r\n") ;
+    ok(59, $x eq "abc\ndef\n\nghi\n") ;
 }
 
 {
@@ -976,9 +1003,8 @@ require POSIX; my $tmp = POSIX::tmpnam();
 foreach my $test (@tests) {
     my $err = test_splice(@$test);
     if (defined $err) {
-       require Data::Dumper;
-       print STDERR "failed: ", Data::Dumper::Dumper($test);
-       print STDERR "error: $err\n";
+       print STDERR "# failed: ", Dumper($test);
+       print STDERR "# error: $err\n";
        $failed = 1;
        ok($testnum++, 0);
     }
@@ -987,7 +1013,7 @@ foreach my $test (@tests) {
 
 if ($failed) {
     # Not worth running the random ones
-    print STDERR 'skipping ', $testnum++, "\n";
+    print STDERR '# skipping ', $testnum++, "\n";
 }
 else {
     # A thousand randomly-generated tests
@@ -997,11 +1023,10 @@ else {
        my $test = rand_test();
        my $err = test_splice(@$test);
        if (defined $err) {
-           require Data::Dumper;
-           print STDERR "failed: ", Data::Dumper::Dumper($test);
-           print STDERR "error: $err\n";
+           print STDERR "# failed: ", Dumper($test);
+           print STDERR "# error: $err\n";
            $failed = 1;
-           print STDERR "skipping any remaining random tests\n";
+           print STDERR "# skipping any remaining random tests\n";
            last;
        }
     }
@@ -1161,7 +1186,7 @@ sub test_splice {
     untie @h;
     
     open(TEXT, $tmp) or die "cannot open $tmp: $!";
-    @h = <TEXT>; chomp @h;
+    @h = <TEXT>; normalise @h; chomp @h;
     close TEXT or die "cannot close $tmp: $!";
     return('list is different when re-read from disk: '
           . Dumper(\@array) . ' vs ' . Dumper(\@h))