From: Paul Marquess Date: Mon, 29 Oct 2001 23:04:23 +0000 (+0000) Subject: RE: DB_File-1.79 on Cygwin 1.3.3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77fd2717e0448991f04f3bffccebd6532a2b65bc;p=p5sagit%2Fp5-mst-13.2.git RE: DB_File-1.79 on Cygwin 1.3.3 Message-ID: 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 --- 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 = ; + my $result = ; 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 = ; - 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 --- 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 = ; 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 --- 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 = ; close(CAT); + normalise($result) ; return $result; } sub docat_del { my $file = shift; - local $/ = undef; - open(CAT,$file) || die "Cannot open $file: $!"; - my $result = ; - 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 = ; chomp @h; + @h = ; 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))