From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 17 May 2002 22:43:35 +0000 (+0100)
Subject: Storable stand alone tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=372cb964568e2238562bfbc998d3099655f1c939;p=p5sagit%2Fp5-mst-13.2.git

Storable stand alone tests
Message-ID: <20020517214334.GG290@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@16664
---

diff --git a/ext/Storable/t/blessed.t b/ext/Storable/t/blessed.t
index 88166dc..4c9ea8e 100644
--- a/ext/Storable/t/blessed.t
+++ b/ext/Storable/t/blessed.t
@@ -15,15 +15,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/canonical.t b/ext/Storable/t/canonical.t
index abc0dcd..0cab212 100644
--- a/ext/Storable/t/canonical.t
+++ b/ext/Storable/t/canonical.t
@@ -15,8 +15,9 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
diff --git a/ext/Storable/t/compat06.t b/ext/Storable/t/compat06.t
index 65f9123..08c2ce5 100644
--- a/ext/Storable/t/compat06.t
+++ b/ext/Storable/t/compat06.t
@@ -18,15 +18,16 @@
 BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/croak.t b/ext/Storable/t/croak.t
index ad07f3a..57c51c0 100644
--- a/ext/Storable/t/croak.t
+++ b/ext/Storable/t/croak.t
@@ -8,15 +8,13 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.';
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    # require 'lib/st-dump.pl';
 }
 
 use strict;
diff --git a/ext/Storable/t/dclone.t b/ext/Storable/t/dclone.t
index 99753c9..563817b 100644
--- a/ext/Storable/t/dclone.t
+++ b/ext/Storable/t/dclone.t
@@ -15,15 +15,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 
diff --git a/ext/Storable/t/downgrade.t b/ext/Storable/t/downgrade.t
index b560508..6e6935d 100644
--- a/ext/Storable/t/downgrade.t
+++ b/ext/Storable/t/downgrade.t
@@ -16,15 +16,15 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.';
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    # require 'lib/st-dump.pl';
 }
 
 use Test::More;
diff --git a/ext/Storable/t/forgive.t b/ext/Storable/t/forgive.t
index a9ac3bf..97d0194 100644
--- a/ext/Storable/t/forgive.t
+++ b/ext/Storable/t/forgive.t
@@ -19,14 +19,16 @@
 #
 
 sub BEGIN {
-    if ($] < 5.006) {
-	print "1..0 # Skip: newer File::Spec needed\n";
-	exit 0;
-    }
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
+    } else {
+	unshift @INC, 't';
+    }
+    require File::Spec;
+    if ($File::Spec::VERSION < 0.8) {
+	print "1..0 # Skip: newer File::Spec needed\n";
+	exit 0;
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
@@ -36,7 +38,7 @@ sub BEGIN {
 }
 
 use Storable qw(store retrieve);
-use File::Spec;
+
 
 print "1..8\n";
 
diff --git a/ext/Storable/t/freeze.t b/ext/Storable/t/freeze.t
index 1582fcf..fd91ad8 100644
--- a/ext/Storable/t/freeze.t
+++ b/ext/Storable/t/freeze.t
@@ -18,15 +18,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
     sub ok;
 }
 
diff --git a/ext/Storable/t/lock.t b/ext/Storable/t/lock.t
index 0f56cc9..6ed9148 100644
--- a/ext/Storable/t/lock.t
+++ b/ext/Storable/t/lock.t
@@ -22,8 +22,9 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
@@ -31,7 +32,7 @@ sub BEGIN {
         exit 0;
     }
 
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/malice.t b/ext/Storable/t/malice.t
index 3881afb..d9de077 100644
--- a/ext/Storable/t/malice.t
+++ b/ext/Storable/t/malice.t
@@ -9,7 +9,6 @@
 
 # I'm trying to keep this test easily backwards compatible to 5.004, so no
 # qr//;
-# Currently using Test not Test::More, as Test is in core that far back.
 
 # This test tries to craft malicious data to test out as many different
 # error traps in Storable as possible
@@ -18,15 +17,13 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.';
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    # require 'lib/st-dump.pl';
 }
 
 use strict;
@@ -39,17 +36,17 @@ $major = 2;
 $minor = 5;
 $minor_write = $] > 5.007 ? 5 : 4;
 
-use Test;
-BEGIN {
-  # If it's 5.7.3 or later the hash will be stored with flags, which is
-  # 2 extra bytes. There are 2 * 2 * 2 tests per byte in the body and header
-  # common to normal and network order serialised objects (hence the 8)
-  # There are only 2 * 2 tests per byte in the parts of the header not present
-  # for network order, and 2 tests per byte on the 'pst0' "magic number" only
-  # present in files, but not in things store()ed to memory
-  $fancy = ($] > 5.007 ? 2 : 0);
-  plan tests => 378 + length($Config{byteorder}) * 4 + $fancy * 8;
-}
+use Test::More;
+
+# If it's 5.7.3 or later the hash will be stored with flags, which is
+# 2 extra bytes. There are 2 * 2 * 2 tests per byte in the body and header
+# common to normal and network order serialised objects (hence the 8)
+# There are only 2 * 2 tests per byte in the parts of the header not present
+# for network order, and 2 tests per byte on the 'pst0' "magic number" only
+# present in files, but not in things store()ed to memory
+$fancy = ($] > 5.007 ? 2 : 0);
+
+plan tests => 378 + length($Config{byteorder}) * 4 + $fancy * 8;
 
 use Storable qw (store retrieve freeze thaw nstore nfreeze);
 
@@ -67,29 +64,25 @@ delete $hash{chr 256};
 
 sub test_hash {
   my $clone = shift;
-  ok (ref $clone, "HASH", "Get hash back");
-  ok (scalar keys %$clone, 1, "with 1 key");
-  ok ((keys %$clone)[0], "perl", "which is correct");
-  ok ($clone->{perl}, "rules");
+  is (ref $clone, "HASH", "Get hash back");
+  is (scalar keys %$clone, 1, "with 1 key");
+  is ((keys %$clone)[0], "perl", "which is correct");
+  is ($clone->{perl}, "rules");
 }
 
 sub test_header {
   my ($header, $isfile, $isnetorder) = @_;
-  ok (!!$header->{file}, !!$isfile, "is file");
-  ok ($header->{major}, $major, "major number");
-  ok ($header->{minor}, $minor_write, "minor number");
-  ok (!!$header->{netorder}, !!$isnetorder, "is network order");
-  if ($isnetorder) {
-    # Skip these
-    for (1..5) {
-      ok (1, 1, "Network order header has no sizes");
-    }
-  } else {
-    ok ($header->{byteorder}, $Config{byteorder}, "byte order");
-    ok ($header->{intsize}, $Config{intsize}, "int size");
-    ok ($header->{longsize}, $Config{longsize}, "long size");
-    ok ($header->{ptrsize}, $Config{ptrsize}, "long size");
-    ok ($header->{nvsize}, $Config{nvsize} || $Config{doublesize} || 8,
+  is (!!$header->{file}, !!$isfile, "is file");
+  is ($header->{major}, $major, "major number");
+  is ($header->{minor}, $minor_write, "minor number");
+  is (!!$header->{netorder}, !!$isnetorder, "is network order");
+ SKIP: {
+    skip "Network order header has no sizes", 5 if ($isnetorder);
+    is ($header->{byteorder}, $Config{byteorder}, "byte order");
+    is ($header->{intsize}, $Config{intsize}, "int size");
+    is ($header->{longsize}, $Config{longsize}, "long size");
+    is ($header->{ptrsize}, $Config{ptrsize}, "long size");
+    is ($header->{nvsize}, $Config{nvsize} || $Config{doublesize} || 8,
         "nv size"); # 5.00405 doesn't even have doublesize in config.
   }
 }
@@ -116,12 +109,12 @@ sub test_truncated {
     my $short = substr $data, 0, $i;
 
     my $clone = &$sub($short);
-    ok (defined ($clone), '', "truncated $what to $i should fail");
+    is (defined ($clone), '', "truncated $what to $i should fail");
     if ($i < $magic_len) {
-      ok ($@, "/^Magic number checking on storable $what failed/",
+      like ($@, "/^Magic number checking on storable $what failed/",
           "Should croak with magic number warning");
     } else {
-      ok ($@, "", "Should not set \$\@");
+      is ($@, "", "Should not set \$\@");
     }
   }
 }
@@ -130,8 +123,8 @@ sub test_corrupt {
   my ($data, $sub, $what, $name) = @_;
 
   my $clone = &$sub($data);
-  ok (defined ($clone), '', "$name $what should fail");
-  ok ($@, $what, $name);
+  is (defined ($clone), '', "$name $what should fail");
+  like ($@, $what, $name);
 }
 
 sub test_things {
@@ -145,7 +138,7 @@ sub test_things {
   # Test that if we re-write it, everything still works:
   my $clone = &$sub ($contents);
 
-  ok ($@, "", "There should be no error");
+  is ($@, "", "There should be no error");
 
   test_hash ($clone);
 
@@ -177,7 +170,7 @@ sub test_things {
   {
     # Now by default newer minor version numbers are not a pain.
     $clone = &$sub($copy);
-    ok ($@, "", "by default no error on higher minor");
+    is ($@, "", "by default no error on higher minor");
     test_hash ($clone);
 
     local $Storable::accept_future_minor = 0;
diff --git a/ext/Storable/t/overload.t b/ext/Storable/t/overload.t
index 7a195f1..e0d204d 100644
--- a/ext/Storable/t/overload.t
+++ b/ext/Storable/t/overload.t
@@ -18,15 +18,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/recurse.t b/ext/Storable/t/recurse.t
index fc82a9a..f10511d 100644
--- a/ext/Storable/t/recurse.t
+++ b/ext/Storable/t/recurse.t
@@ -26,15 +26,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/restrict.t b/ext/Storable/t/restrict.t
index 841baab..24e7b9d 100644
--- a/ext/Storable/t/restrict.t
+++ b/ext/Storable/t/restrict.t
@@ -8,10 +8,9 @@
 #
 
 sub BEGIN {
+    chdir('t') if -d 't';
     if ($ENV{PERL_CORE}){
-	chdir('t') if -d 't';
-	@INC = '.';
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
         require Config;
         if ($Config::Config{'extensions'} !~ /\bStorable\b/) {
             print "1..0 # Skip: Storable was not built\n";
@@ -26,8 +25,9 @@ sub BEGIN {
                 die;
             }
         }
+	unshift @INC, 't';
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 
diff --git a/ext/Storable/t/retrieve.t b/ext/Storable/t/retrieve.t
index 33e6227..96701ba 100644
--- a/ext/Storable/t/retrieve.t
+++ b/ext/Storable/t/retrieve.t
@@ -15,15 +15,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 
diff --git a/ext/Storable/t/store.t b/ext/Storable/t/store.t
index 08be4c6..94df1c0 100644
--- a/ext/Storable/t/store.t
+++ b/ext/Storable/t/store.t
@@ -15,15 +15,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
diff --git a/ext/Storable/t/tied.t b/ext/Storable/t/tied.t
index 146c544..327074d 100644
--- a/ext/Storable/t/tied.t
+++ b/ext/Storable/t/tied.t
@@ -15,15 +15,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/tied_hook.t b/ext/Storable/t/tied_hook.t
index 7a21301..b085285 100644
--- a/ext/Storable/t/tied_hook.t
+++ b/ext/Storable/t/tied_hook.t
@@ -18,15 +18,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/tied_items.t b/ext/Storable/t/tied_items.t
index 40fd476..0198f44 100644
--- a/ext/Storable/t/tied_items.t
+++ b/ext/Storable/t/tied_items.t
@@ -19,15 +19,16 @@
 sub BEGIN {
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 sub ok;
diff --git a/ext/Storable/t/utf8.t b/ext/Storable/t/utf8.t
index 600bcf2..890834f 100644
--- a/ext/Storable/t/utf8.t
+++ b/ext/Storable/t/utf8.t
@@ -23,15 +23,16 @@ sub BEGIN {
     }
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib', '../t/lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
-    require 'lib/st-dump.pl';
+    require 'st-dump.pl';
 }
 
 use strict;
diff --git a/ext/Storable/t/utf8hash.t b/ext/Storable/t/utf8hash.t
index a545ac7..1aff2b9 100644
--- a/ext/Storable/t/utf8hash.t
+++ b/ext/Storable/t/utf8hash.t
@@ -11,8 +11,9 @@ sub BEGIN {
     }
     if ($ENV{PERL_CORE}){
 	chdir('t') if -d 't';
-	@INC = '.'; 
-	push @INC, '../lib';
+	@INC = ('.', '../lib');
+    } else {
+	unshift @INC, 't';
     }
     require Config; import Config;
     if ($ENV{PERL_CORE}){
@@ -21,7 +22,6 @@ sub BEGIN {
 	    exit 0;
 	}
     }
-    # require 'lib/st-dump.pl';
 }
 
 use strict;