From 372cb964568e2238562bfbc998d3099655f1c939 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 17 May 2002 23:43:35 +0100 Subject: [PATCH] Storable stand alone tests Message-ID: <20020517214334.GG290@Bagpuss.unfortu.net> p4raw-id: //depot/perl@16664 --- ext/Storable/t/blessed.t | 7 +++-- ext/Storable/t/canonical.t | 5 +-- ext/Storable/t/compat06.t | 7 +++-- ext/Storable/t/croak.t | 4 +-- ext/Storable/t/dclone.t | 7 +++-- ext/Storable/t/downgrade.t | 6 ++-- ext/Storable/t/forgive.t | 16 +++++----- ext/Storable/t/freeze.t | 7 +++-- ext/Storable/t/lock.t | 7 +++-- ext/Storable/t/malice.t | 75 ++++++++++++++++++++------------------------- ext/Storable/t/overload.t | 7 +++-- ext/Storable/t/recurse.t | 7 +++-- ext/Storable/t/restrict.t | 8 ++--- ext/Storable/t/retrieve.t | 7 +++-- ext/Storable/t/store.t | 7 +++-- ext/Storable/t/tied.t | 7 +++-- ext/Storable/t/tied_hook.t | 7 +++-- ext/Storable/t/tied_items.t | 7 +++-- ext/Storable/t/utf8.t | 7 +++-- ext/Storable/t/utf8hash.t | 6 ++-- 20 files changed, 109 insertions(+), 102 deletions(-) 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; -- 2.7.4