From dddb60fcaabdeab9e89341f56cd3c6ad6ad3cd90 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 10 Dec 2010 14:38:52 +0000 Subject: [PATCH] Convert all Storable's tests to use Test::More. Originally Storable didn't use any test modules, and had an ok subroutine in t/st-dump.pl. Subsequently some tests were made conditional on Test::More loading, and more recently the distribution started bundling Test::More, at which point newer tests were written to use it. However, the older tests have never been refactored to use it. Hence refactor tests to use Test::More, and delete the now-unused test functions from t/st-dump.pl Tested on blead and 5.004. --- dist/Storable/t/blessed.t | 82 +++++++++++++++++++++----------------------- dist/Storable/t/canonical.t | 25 +++++--------- dist/Storable/t/compat01.t | 17 ++++----- dist/Storable/t/compat06.t | 21 +++++------- dist/Storable/t/dclone.t | 50 +++++++++++---------------- dist/Storable/t/forgive.t | 23 ++++++------- dist/Storable/t/freeze.t | 67 +++++++++++++++--------------------- dist/Storable/t/lock.t | 19 +++++----- dist/Storable/t/overload.t | 43 +++++++++++------------ dist/Storable/t/recurse.t | 72 ++++++++++++++++++-------------------- dist/Storable/t/restrict.t | 42 +++++++---------------- dist/Storable/t/retrieve.t | 43 ++++++++--------------- dist/Storable/t/sig_die.t | 12 +------ dist/Storable/t/st-dump.pl | 29 ---------------- dist/Storable/t/tied.t | 46 ++++++++++++------------- dist/Storable/t/tied_hook.t | 52 ++++++++++++++-------------- dist/Storable/t/tied_items.t | 21 +++++------- dist/Storable/t/utf8.t | 18 ++++------ 18 files changed, 278 insertions(+), 404 deletions(-) diff --git a/dist/Storable/t/blessed.t b/dist/Storable/t/blessed.t index b8ae067..9bc9512 100644 --- a/dist/Storable/t/blessed.t +++ b/dist/Storable/t/blessed.t @@ -13,10 +13,9 @@ sub BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } -sub ok; +use Test::More; use Storable qw(freeze thaw store retrieve); @@ -28,7 +27,7 @@ use Storable qw(freeze thaw store retrieve); my $test = 12; my $tests = $test + 22 + 2 * 6 * keys %::immortals; -print "1..$tests\n"; +plan(tests => $tests); package SHORT_NAME; @@ -61,15 +60,14 @@ package $name; \@ISA = ("SHORT_NAME"); EOC -die $@ if $@; -ok 1, $@ eq ''; +is($@, ''); eval <[0] eq 'SHORT_NAME'; -ok 7, ref $y->[1] eq 'SHORT_NAME_WITH_HOOK'; -ok 8, ref $y->[2] eq $name; -ok 9, ref $y->[3] eq "${name}_WITH_HOOK"; +is(ref $y->[0], 'SHORT_NAME'); +is(ref $y->[1], 'SHORT_NAME_WITH_HOOK'); +is(ref $y->[2], $name); +is(ref $y->[3], "${name}_WITH_HOOK"); my $good = 1; for (my $i = 0; $i < 10; $i++) { @@ -100,14 +98,14 @@ for (my $i = 0; $i < 10; $i++) { do { $good = 0; last } unless ref $y->[4*$i+2] eq $name; do { $good = 0; last } unless ref $y->[4*$i+3] eq "${name}_WITH_HOOK"; } -ok 10, $good; +is($good, 1); { my $blessed_ref = bless \\[1,2,3], 'Foobar'; my $x = freeze $blessed_ref; my $y = thaw $x; - ok 11, ref $y eq 'Foobar'; - ok 12, $$$y->[0] == 1; + is(ref $y, 'Foobar'); + is($$$y->[0], 1); } package RETURNS_IMMORTALS; @@ -127,14 +125,14 @@ sub STORABLE_thaw { my ($x, @refs) = @_; my ($what, $times) = $x =~ /(.)(\d+)/; die "'$x' didn't match" unless defined $times; - main::ok ++$test, @refs == $times; + main::is(scalar @refs, $times); my $expect = $::immortals{$what}; die "'$x' did not give a reference" unless ref $expect; my $fail; foreach (@refs) { $fail++ if $_ != $expect; } - main::ok ++$test, !$fail; + main::is($fail, undef); } package main; @@ -148,9 +146,9 @@ foreach $count (1..3) { my $i = RETURNS_IMMORTALS->make ($immortal, $count); my $f = freeze ($i); - ok ++$test, $f; + isnt($f, undef); my $t = thaw $f; - ok ++$test, 1; + pass("thaw didn't crash"); } } @@ -174,23 +172,23 @@ package main; my $f = freeze (HAS_HOOK->make); -ok ++$test, $HAS_HOOK::loaded_count == 0; -ok ++$test, $HAS_HOOK::thawed_count == 0; +is($HAS_HOOK::loaded_count, 0); +is($HAS_HOOK::thawed_count, 0); my $t = thaw $f; -ok ++$test, $HAS_HOOK::loaded_count == 1; -ok ++$test, $HAS_HOOK::thawed_count == 1; -ok ++$test, $t; -ok ++$test, ref $t eq 'HAS_HOOK'; +is($HAS_HOOK::loaded_count, 1); +is($HAS_HOOK::thawed_count, 1); +isnt($t, undef); +is(ref $t, 'HAS_HOOK'); delete $INC{"HAS_HOOK.pm"}; delete $HAS_HOOK::{STORABLE_thaw}; $t = thaw $f; -ok ++$test, $HAS_HOOK::loaded_count == 2; -ok ++$test, $HAS_HOOK::thawed_count == 2; -ok ++$test, $t; -ok ++$test, ref $t eq 'HAS_HOOK'; +is($HAS_HOOK::loaded_count, 2); +is($HAS_HOOK::thawed_count, 2); +isnt($t, undef); +is(ref $t, 'HAS_HOOK'); { package STRESS_THE_STACK; @@ -223,14 +221,14 @@ $STRESS_THE_STACK::thaw_count = 0; $f = freeze (STRESS_THE_STACK->make); -ok ++$test, $STRESS_THE_STACK::freeze_count == 1; -ok ++$test, $STRESS_THE_STACK::thaw_count == 0; +is($STRESS_THE_STACK::freeze_count, 1); +is($STRESS_THE_STACK::thaw_count, 0); $t = thaw $f; -ok ++$test, $STRESS_THE_STACK::freeze_count == 1; -ok ++$test, $STRESS_THE_STACK::thaw_count == 1; -ok ++$test, $t; -ok ++$test, ref $t eq 'STRESS_THE_STACK'; +is($STRESS_THE_STACK::freeze_count, 1); +is($STRESS_THE_STACK::thaw_count, 1); +isnt($t, undef); +is(ref $t, 'STRESS_THE_STACK'); my $file = "storable-testfile.$$"; die "Temporary file '$file' already exists" if -e $file; @@ -242,11 +240,11 @@ $STRESS_THE_STACK::thaw_count = 0; store (STRESS_THE_STACK->make, $file); -ok ++$test, $STRESS_THE_STACK::freeze_count == 1; -ok ++$test, $STRESS_THE_STACK::thaw_count == 0; +is($STRESS_THE_STACK::freeze_count, 1); +is($STRESS_THE_STACK::thaw_count, 0); $t = retrieve ($file); -ok ++$test, $STRESS_THE_STACK::freeze_count == 1; -ok ++$test, $STRESS_THE_STACK::thaw_count == 1; -ok ++$test, $t; -ok ++$test, ref $t eq 'STRESS_THE_STACK'; +is($STRESS_THE_STACK::freeze_count, 1); +is($STRESS_THE_STACK::thaw_count, 1); +isnt($t, undef); +is(ref $t, 'STRESS_THE_STACK'); diff --git a/dist/Storable/t/canonical.t b/dist/Storable/t/canonical.t index 204a235..034ac08 100644 --- a/dist/Storable/t/canonical.t +++ b/dist/Storable/t/canonical.t @@ -19,14 +19,7 @@ sub BEGIN { use Storable qw(freeze thaw dclone); use vars qw($debugging $verbose); -print "1..8\n"; - -sub ok { - my($testno, $ok) = @_; - print "not " unless $ok; - print "ok $testno\n"; -} - +use Test::More tests => 8; # Uncomment the folowing line to get a dump of the constructed data structure # (you may want to reduce the size of the hashes too) @@ -106,10 +99,10 @@ $x1 = freeze(\%a1); $x2 = freeze(\%a2); $x3 = freeze($a3); -ok 1, (length($x1) > $hashsize); # sanity check -ok 2, length($x1) == length($x2); # idem -ok 3, $x1 eq $x2; -ok 4, $x1 eq $x3; +cmp_ok(length $x1, '>', $hashsize); # sanity check +is(length $x1, length $x2); # idem +is($x1, $x2); +is($x1, $x3); # In normal mode it is exceedingly unlikely that the frozen # representaions of all the hashes will be the same (normally the hash @@ -127,7 +120,7 @@ $x3 = freeze($a3); # is much, much more unlikely. Still it could happen, so this test # may report a false negative. -ok 5, ($x1 ne $x2) || ($x1 ne $x3); +ok(($x1 ne $x2) || ($x1 ne $x3)); # Ensure refs to "undef" values are properly shared @@ -135,10 +128,10 @@ ok 5, ($x1 ne $x2) || ($x1 ne $x3); my $hash; push @{$$hash{''}}, \$$hash{a}; -ok 6, $$hash{''}[0] == \$$hash{a}; +is($$hash{''}[0], \$$hash{a}); my $cloned = dclone(dclone($hash)); -ok 7, $$cloned{''}[0] == \$$cloned{a}; +is($$cloned{''}[0], \$$cloned{a}); $$cloned{a} = "blah"; -ok 8, $$cloned{''}[0] == \$$cloned{a}; +is($$cloned{''}[0], \$$cloned{a}); diff --git a/dist/Storable/t/compat01.t b/dist/Storable/t/compat01.t index 9b47212..f234916 100644 --- a/dist/Storable/t/compat01.t +++ b/dist/Storable/t/compat01.t @@ -17,6 +17,7 @@ BEGIN { use strict; use Storable qw(retrieve); +use Test::More; my $file = "xx-$$.pst"; my @dumps = ( @@ -25,7 +26,7 @@ my @dumps = ( "perl-store\0\x041234\4\4\4\x94y\22\b\3\1\0\0\0vxz\22\b\b\x81Xk\3\0\0\0oneX", # 0.4@7 ); -print "1.." . @dumps . "\n"; +plan(tests => 3 * @dumps); my $testno; for my $dump (@dumps) { @@ -36,16 +37,10 @@ for my $dump (@dumps) { print FH $dump; close(FH) || die "Can't write $file: $!"; - eval { - my $data = retrieve($file); - if (ref($data) eq "HASH" && $data->{one} eq "1") { - print "ok $testno\n"; - } - else { - print "not ok $testno\n"; - } - }; - warn $@ if $@; + my $data = eval { retrieve($file) }; + is($@, '', "No errors for $file"); + is(ref $data, 'HASH', "Got HASH for $file"); + is($data->{one}, 1, "Got data for $file"); unlink($file); } diff --git a/dist/Storable/t/compat06.t b/dist/Storable/t/compat06.t index 6d8ade3..758a500 100644 --- a/dist/Storable/t/compat06.t +++ b/dist/Storable/t/compat06.t @@ -13,12 +13,9 @@ BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } -sub ok; - -print "1..8\n"; +use Test::More tests => 8; use Storable qw(freeze nfreeze thaw); @@ -99,29 +96,29 @@ if (!$is_EBCDIC) { # ASCII machine } my $expected_length = $is_EBCDIC ? 217 : 278; -ok 1, length $data == $expected_length; +is(length $data, $expected_length); my $y = thaw($data); -ok 2, 1; -ok 3, ref $y eq 'ROOT'; +isnt($y, undef); +is(ref $y, 'ROOT'); $Storable::canonical = 1; # Prevent "used once" warning $Storable::canonical = 1; # Allow for long double string conversions. $y->{num}->[3] += 0; $r->{num}->[3] += 0; -ok 4, nfreeze($y) eq nfreeze($r); +is(nfreeze($y), nfreeze($r)); -ok 5, $y->ref->{key1} eq 'val1'; -ok 6, $y->ref->{key2} eq 'val2'; -ok 7, $hash_fetch == 2; +is($y->ref->{key1}, 'val1'); +is($y->ref->{key2}, 'val2'); +is($hash_fetch, 2); my $num = $r->num; my $ok = 1; for (my $i = 0; $i < @$num; $i++) { do { $ok = 0; last } unless $num->[$i] == $y->num->[$i]; } -ok 8, $ok; +is($ok, 1); __END__ # diff --git a/dist/Storable/t/dclone.t b/dist/Storable/t/dclone.t index 078cd81..74d1b5c 100644 --- a/dist/Storable/t/dclone.t +++ b/dist/Storable/t/dclone.t @@ -19,7 +19,7 @@ sub BEGIN { use Storable qw(dclone); -print "1..12\n"; +use Test::More tests => 14; $a = 'toto'; $b = \$a; @@ -29,17 +29,16 @@ $c->{attribute} = 'attrval'; @a = ('first', undef, 3, -4, -3.14159, 456, 4.5, $b, \$a, $a, $c, \$c, \%a); -print "not " unless defined ($aref = dclone(\@a)); -print "ok 1\n"; +my $aref = dclone(\@a); +isnt($aref, undef); $dumped = &dump(\@a); -print "ok 2\n"; +isnt($dumped, undef); $got = &dump($aref); -print "ok 3\n"; +isnt($got, undef); -print "not " unless $got eq $dumped; -print "ok 4\n"; +is($got, $dumped); package FOO; @ISA = qw(Storable); @@ -52,25 +51,21 @@ sub make { package main; $foo = FOO->make; -print "not " unless defined($r = $foo->dclone); -print "ok 5\n"; +my $r = $foo->dclone; +isnt($r, undef); -print "not " unless &dump($foo) eq &dump($r); -print "ok 6\n"; +is(&dump($foo), &dump($r)); # Ensure refs to "undef" values are properly shared during cloning my $hash; push @{$$hash{''}}, \$$hash{a}; -print "not " unless $$hash{''}[0] == \$$hash{a}; -print "ok 7\n"; +is($$hash{''}[0], \$$hash{a}); my $cloned = dclone(dclone($hash)); -print "not " unless $$cloned{''}[0] == \$$cloned{a}; -print "ok 8\n"; +is($$cloned{''}[0], \$$cloned{a}); $$cloned{a} = "blah"; -print "not " unless $$cloned{''}[0] == \$$cloned{a}; -print "ok 9\n"; +is($$cloned{''}[0], \$$cloned{a}); # [ID 20020221.007] SEGV in Storable with empty string scalar object package TestString; @@ -82,25 +77,20 @@ package main; my $empty_string_obj = TestString->new(''); my $clone = dclone($empty_string_obj); # If still here after the dclone the fix (#17543) worked. -print ref $clone eq ref $empty_string_obj && - $$clone eq $$empty_string_obj && - $$clone eq '' ? "ok 10\n" : "not ok 10\n"; +is(ref $clone, ref $empty_string_obj); +is($$clone, $$empty_string_obj); +is($$clone, ''); +SKIP: { # Do not fail if Tie::Hash and/or Tie::StdHash is not available -if (eval { require Tie::Hash; scalar keys %Tie::StdHash:: }) { + skip 'No Tie::StdHash available', 2 + unless eval { require Tie::Hash; scalar keys %Tie::StdHash:: }; tie my %tie, "Tie::StdHash" or die $!; $tie{array} = [1,2,3,4]; $tie{hash} = {1,2,3,4}; my $clone_array = dclone $tie{array}; - print "not " unless "@$clone_array" eq "@{$tie{array}}"; - print "ok 11\n"; + is("@$clone_array", "@{$tie{array}}"); my $clone_hash = dclone $tie{hash}; - print "not " unless $clone_hash->{1} eq $tie{hash}{1}; - print "ok 12\n"; -} else { - print <{1}, $tie{hash}{1}); } diff --git a/dist/Storable/t/forgive.t b/dist/Storable/t/forgive.t index 495edc3..d65f3bc 100644 --- a/dist/Storable/t/forgive.t +++ b/dist/Storable/t/forgive.t @@ -19,26 +19,25 @@ sub BEGIN { } use Storable qw(store retrieve); +use Test::More; # problems with 5.00404 when in an BEGIN block, so this is defined here if (!eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) { - print "1..0 # Skip: File::Spec 0.8 needed\n"; - exit 0; + plan(skip_all => "File::Spec 0.8 needed"); # Mention $File::Spec::VERSION again, as 5.00503's harness seems to have # warnings on. exit $File::Spec::VERSION; } -print "1..8\n"; +plan(tests => 8); -my $test = 1; *GLOB = *GLOB; # peacify -w my $bad = ['foo', \*GLOB, 'bar']; my $result; eval {$result = store ($bad , 'store')}; -print ((!defined $result)?"ok $test\n":"not ok $test\n"); $test++; -print (($@ ne '')?"ok $test\n":"not ok $test\n"); $test++; +is($result, undef); +isnt($@, ''); $Storable::forgive_me=1; @@ -52,14 +51,14 @@ eval {$result = store ($bad , 'store')}; open(STDERR, ">&SAVEERR"); -print ((defined $result)?"ok $test\n":"not ok $test\n"); $test++; -print (($@ eq '')?"ok $test\n":"not ok $test\n"); $test++; +isnt($result, undef); +is($@, ''); my $ret = retrieve('store'); -print ((defined $ret)?"ok $test\n":"not ok $test\n"); $test++; -print (($ret->[0] eq 'foo')?"ok $test\n":"not ok $test\n"); $test++; -print (($ret->[2] eq 'bar')?"ok $test\n":"not ok $test\n"); $test++; -print ((ref $ret->[1] eq 'SCALAR')?"ok $test\n":"not ok $test\n"); $test++; +isnt($ret, undef); +is($ret->[0], 'foo'); +is($ret->[2], 'bar'); +is(ref $ret->[1], 'SCALAR'); END { 1 while unlink 'store' } diff --git a/dist/Storable/t/freeze.t b/dist/Storable/t/freeze.t index e76b669..bc3babc 100644 --- a/dist/Storable/t/freeze.t +++ b/dist/Storable/t/freeze.t @@ -14,12 +14,11 @@ sub BEGIN { exit 0; } require 'st-dump.pl'; - sub ok; } use Storable qw(freeze nfreeze thaw); -print "1..20\n"; +use Test::More tests => 21; $a = 'toto'; $b = \$a; @@ -33,21 +32,19 @@ $e->[0] = $d; @a = ('first', undef, 3, -4, -3.14159, 456, 4.5, $d, \$d, \$e, $e, $b, \$a, $a, $c, \$c, \%a); -print "not " unless defined ($f1 = freeze(\@a)); -print "ok 1\n"; +my $f1 = freeze(\@a); +isnt($f1, undef); $dumped = &dump(\@a); -print "ok 2\n"; +isnt($dumped, undef); $root = thaw($f1); -print "not " unless defined $root; -print "ok 3\n"; +isnt($root, undef); $got = &dump($root); -print "ok 4\n"; +isnt($got, undef); -print "not " unless $got eq $dumped; -print "ok 5\n"; +is($got, $dumped); package FOO; @ISA = qw(Storable); @@ -60,33 +57,27 @@ sub make { package main; $foo = FOO->make; -print "not " unless $f2 = $foo->freeze; -print "ok 6\n"; +my $f2 = $foo->freeze; +isnt($f2, undef); -print "not " unless $f3 = $foo->nfreeze; -print "ok 7\n"; +my $f3 = $foo->nfreeze; +isnt($f3, undef); $root3 = thaw($f3); -print "not " unless defined $root3; -print "ok 8\n"; +isnt($root3, undef); -print "not " unless &dump($foo) eq &dump($root3); -print "ok 9\n"; +is(&dump($foo), &dump($root3)); $root = thaw($f2); -print "not " unless &dump($foo) eq &dump($root); -print "ok 10\n"; +is(&dump($foo), &dump($root)); -print "not " unless &dump($root3) eq &dump($root); -print "ok 11\n"; +is(&dump($root3), &dump($root)); $other = freeze($root); -print "not " unless length($other) == length($f2); -print "ok 12\n"; +is(length$other, length $f2); $root2 = thaw($other); -print "not " unless &dump($root2) eq &dump($root); -print "ok 13\n"; +is(&dump($root2), &dump($root)); $VAR1 = [ 'method', @@ -98,16 +89,14 @@ $VAR1 = [ $x = nfreeze($VAR1); $VAR2 = thaw($x); -print "not " unless $VAR2->[3] eq $VAR1->[3]; -print "ok 14\n"; +is($VAR2->[3], $VAR1->[3]); # Test the workaround for LVALUE bug in perl 5.004_04 -- from Gisle Aas sub foo { $_[0] = 1 } $foo = []; foo($foo->[1]); eval { freeze($foo) }; -print "not " if $@; -print "ok 15\n"; +is($@, ''); # Test cleanup bug found by Claudio Garcia -- RAM, 08/06/2001 my $thaw_me = 'asdasdasdasd'; @@ -115,32 +104,32 @@ my $thaw_me = 'asdasdasdasd'; eval { my $thawed = thaw $thaw_me; }; -ok 16, $@; +isnt($@, ''); my %to_be_frozen = (foo => 'bar'); my $frozen; eval { $frozen = freeze \%to_be_frozen; }; -ok 17, !$@; +is($@, ''); freeze {}; eval { thaw $thaw_me }; eval { $frozen = freeze { foo => {} } }; -ok 18, !$@; +is($@, ''); thaw $frozen; # used to segfault here -ok 19, 1; +pass("Didn't segfault"); -if ($] >= 5.006) { +SKIP: { + skip 'no av_exists', 2 unless $] >= 5.006; + my (@a, @b); eval ' $a = []; $#$a = 2; $a->[1] = undef; $b = thaw freeze $a; @a = map { ~~ exists $a->[$_] } 0 .. $#$a; @b = map { ~~ exists $b->[$_] } 0 .. $#$b; - ok 20, "@a" eq "@b"; '; -} -else { - print "ok 20 # skipped (no av_exists)\n"; + is($@, ''); + is("@a", "@b"); } diff --git a/dist/Storable/t/lock.t b/dist/Storable/t/lock.t index 14b5f42..3183243 100644 --- a/dist/Storable/t/lock.t +++ b/dist/Storable/t/lock.t @@ -17,16 +17,14 @@ sub BEGIN { require 'st-dump.pl'; } -sub ok; - +use Test::More; use Storable qw(lock_store lock_retrieve); unless (&Storable::CAN_FLOCK) { - print "1..0 # Skip: fcntl/flock emulation broken on this platform\n"; - exit 0; + plan(skip_all => "fcntl/flock emulation broken on this platform"); } -print "1..5\n"; +plan(tests => 5); @a = ('first', undef, 3, -4, -3.14159, 456, 4.5); @@ -34,13 +32,14 @@ print "1..5\n"; # We're just ensuring things work, we're not validating locking. # -ok 1, defined lock_store(\@a, 'store'); -ok 2, $dumped = &dump(\@a); +isnt(lock_store(\@a, 'store'), undef); +my $dumped = &dump(\@a); +isnt($dumped, undef); $root = lock_retrieve('store'); -ok 3, ref $root eq 'ARRAY'; -ok 4, @a == @$root; -ok 5, &dump($root) eq $dumped; +is(ref $root, 'ARRAY'); +is(scalar @a, scalar @$root); +is(&dump($root), $dumped); unlink 't/store'; diff --git a/dist/Storable/t/overload.t b/dist/Storable/t/overload.t index 22fccfb..e3e4837 100644 --- a/dist/Storable/t/overload.t +++ b/dist/Storable/t/overload.t @@ -13,14 +13,11 @@ sub BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } -sub ok; - use Storable qw(freeze thaw); -print "1..19\n"; +use Test::More tests => 19; package OVERLOADED; @@ -32,18 +29,18 @@ package main; $a = bless [77], OVERLOADED; $b = thaw freeze $a; -ok 1, ref $b eq 'OVERLOADED'; -ok 2, "$b" eq "77"; +is(ref $b, 'OVERLOADED'); +is("$b", "77"); $c = thaw freeze \$a; -ok 3, ref $c eq 'REF'; -ok 4, ref $$c eq 'OVERLOADED'; -ok 5, "$$c" eq "77"; +is(ref $c, 'REF'); +is(ref $$c, 'OVERLOADED'); +is("$$c", "77"); $d = thaw freeze [$a, $a]; -ok 6, "$d->[0]" eq "77"; +is("$d->[0]", "77"); $d->[0][0]++; -ok 7, "$d->[1]" eq "78"; +is("$d->[1]", "78"); package REF_TO_OVER; @@ -76,11 +73,11 @@ package main; $a = OVER->make(); $b = thaw freeze $a; -ok 8, ref $b eq 'OVER'; -ok 9, $a + $a == 314; -ok 10, ref $b->{ref} eq 'REF_TO_OVER'; -ok 11, "$b->{ref}->{over}" eq "$b"; -ok 12, $b + $b == 314; +is(ref $b, 'OVER'); +is($a + $a, 314); +is(ref $b->{ref}, 'REF_TO_OVER'); +is("$b->{ref}->{over}", "$b"); +is($b + $b, 314); # nfreeze data generated by make_overload.pl my $f = ''; @@ -94,10 +91,10 @@ if (ord ('A') == 193) { # EBCDIC. # use a reference to an overloaded reference, rather than just a reference. my $t = eval {thaw $f}; print "# $@" if $@; -ok 13, $@ eq ""; -ok 14, ref ($t) eq 'REF'; -ok 15, ref ($$t) eq 'HAS_OVERLOAD'; -ok 16, $$$t eq 'snow'; +is($@, ""); +is(ref ($t), 'REF'); +is(ref ($$t), 'HAS_OVERLOAD'); +is($$$t, 'snow'); #--- @@ -105,9 +102,9 @@ ok 16, $$$t eq 'snow'; { my $a = bless [88], 'OVERLOADED'; my $c = thaw freeze bless \$a, 'main'; - ok 17, ref $c eq 'main'; - ok 18, ref $$c eq 'OVERLOADED'; - ok 19, "$$c" eq "88"; + is(ref $c, 'main'); + is(ref $$c, 'OVERLOADED'); + is("$$c", "88"); } diff --git a/dist/Storable/t/recurse.t b/dist/Storable/t/recurse.t index d7dcb0e..bc34d73 100644 --- a/dist/Storable/t/recurse.t +++ b/dist/Storable/t/recurse.t @@ -13,14 +13,10 @@ sub BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } -sub ok; - use Storable qw(freeze thaw dclone); - -print "1..33\n"; +use Test::More tests => 33; package OBJ_REAL; @@ -132,51 +128,51 @@ package main; my $real = OBJ_REAL->make; my $x = freeze $real; -ok 1, 1; +isnt($x, undef); my $y = thaw $x; -ok 2, ref $y eq 'OBJ_REAL'; -ok 3, $y->[0] eq 'a'; -ok 4, $y->[1] == 1; +is(ref $y, 'OBJ_REAL'); +is($y->[0], 'a'); +is($y->[1], 1); my $sync = OBJ_SYNC->make; $x = freeze $sync; -ok 5, 1; +isnt($x, undef); $y = thaw $x; -ok 6, 1; -ok 7, $y->{ok} == $y; +is(ref $y, 'OBJ_SYNC'); +is($y->{ok}, $y); my $ext = [1, 2]; $sync = OBJ_SYNC2->make($ext); $x = freeze [$sync, $ext]; -ok 8, 1; +isnt($x, undef); my $z = thaw $x; $y = $z->[0]; -ok 9, 1; -ok 10, $y->{ok} == $y; -ok 11, ref $y->{sync} eq 'OBJ_SYNC'; -ok 12, $y->{ext} == $z->[1]; +is(ref $y, 'OBJ_SYNC2'); +is($y->{ok}, $y); +is(ref $y->{sync}, 'OBJ_SYNC'); +is($y->{ext}, $z->[1]); $real = OBJ_REAL2->make; $x = freeze $real; -ok 13, 1; -ok 14, $OBJ_REAL2::recursed == $OBJ_REAL2::MAX; -ok 15, $OBJ_REAL2::hook_called == $OBJ_REAL2::MAX; +isnt($x, undef); +is($OBJ_REAL2::recursed, $OBJ_REAL2::MAX); +is($OBJ_REAL2::hook_called, $OBJ_REAL2::MAX); $y = thaw $x; -ok 16, 1; -ok 17, $OBJ_REAL2::recursed == 0; +is(ref $y, 'OBJ_REAL2'); +is($OBJ_REAL2::recursed, 0); $x = dclone $real; -ok 18, 1; -ok 19, ref $x eq 'OBJ_REAL2'; -ok 20, $OBJ_REAL2::recursed == 0; -ok 21, $OBJ_REAL2::hook_called == 2 * $OBJ_REAL2::MAX; +isnt($x, undef); +is(ref $x, 'OBJ_REAL2'); +is($OBJ_REAL2::recursed, 0); +is($OBJ_REAL2::hook_called, 2 * $OBJ_REAL2::MAX); -ok 22, !Storable::is_storing; -ok 23, !Storable::is_retrieving; +is(Storable::is_storing, ''); +is(Storable::is_retrieving, ''); # # The following was a test-case that Salvador Ortiz Garcia @@ -219,11 +215,11 @@ package main; my $bar = new Bar; my $bar2 = thaw freeze $bar; -ok 24, ref($bar2) eq 'Bar'; -ok 25, ref($bar->{b}[0]) eq 'Foo'; -ok 26, ref($bar->{b}[1]) eq 'Foo'; -ok 27, ref($bar2->{b}[0]) eq 'Foo'; -ok 28, ref($bar2->{b}[1]) eq 'Foo'; +is(ref($bar2), 'Bar'); +is(ref($bar->{b}[0]), 'Foo'); +is(ref($bar->{b}[1]), 'Foo'); +is(ref($bar2->{b}[0]), 'Foo'); +is(ref($bar2->{b}[1]), 'Foo'); # # The following attempts to make sure blessed objects are blessed ASAP @@ -256,10 +252,10 @@ sub STORABLE_freeze { sub STORABLE_thaw { my($self, $clonning, $frozen, $c1, $c3, $o) = @_; - main::ok 29, ref $self eq "CLASS_2"; - main::ok 30, ref $c1 eq "CLASS_1"; - main::ok 31, ref $c3 eq "CLASS_3"; - main::ok 32, ref $o eq "CLASS_OTHER"; + main::is(ref $self, "CLASS_2"); + main::is(ref $c1, "CLASS_1"); + main::is(ref $c3, "CLASS_3"); + main::is(ref $o, "CLASS_OTHER"); $self->{c1} = $c1; $self->{c3} = $c3; } @@ -312,4 +308,4 @@ my $so = thaw freeze $o; $refcount_ok = 0; thaw freeze(Foo3->new); -ok 33, $refcount_ok == 1; +is($refcount_ok, 1); diff --git a/dist/Storable/t/restrict.t b/dist/Storable/t/restrict.t index be7f408..20e8165 100644 --- a/dist/Storable/t/restrict.t +++ b/dist/Storable/t/restrict.t @@ -30,14 +30,12 @@ sub BEGIN { } unshift @INC, 't'; } - require 'st-dump.pl'; } use Storable qw(dclone freeze thaw); use Hash::Util qw(lock_hash unlock_value); - -print "1..100\n"; +use Test::More tests => 100; my %hash = (question => '?', answer => 42, extra => 'junk', undef => undef); lock_hash %hash; @@ -67,42 +65,32 @@ sub testit { my @in_keys = sort keys %$hash; my @out_keys = sort keys %$copy; - unless (ok ++$test, "@in_keys" eq "@out_keys") { - print "# Failed: keys mis-match after deep clone.\n"; - print "# Original keys: @in_keys\n"; - print "# Copy's keys: @out_keys\n"; - } + is("@in_keys", "@out_keys", "keys match after deep clone"); # $copy = $hash; # used in initial debug of the tests - ok ++$test, Internals::SvREADONLY(%$copy), "cloned hash restricted?"; + is(Internals::SvREADONLY(%$copy), 1, "cloned hash restricted?"); - ok ++$test, Internals::SvREADONLY($copy->{question}), - "key 'question' not locked in copy?"; + is(Internals::SvREADONLY($copy->{question}), 1, + "key 'question' not locked in copy?"); - ok ++$test, !Internals::SvREADONLY($copy->{answer}), - "key 'answer' not locked in copy?"; + is(Internals::SvREADONLY($copy->{answer}), '', + "key 'answer' not locked in copy?"); eval { $copy->{extra} = 15 } ; - unless (ok ++$test, !$@, "Can assign to reserved key 'extra'?") { - my $diag = $@; - $diag =~ s/\n.*\z//s; - print "# \$\@: $diag\n"; - } + is($@, '', "Can assign to reserved key 'extra'?"); eval { $copy->{nono} = 7 } ; - ok ++$test, $@, "Can not assign to invalid key 'nono'?"; + isnt($@, '', "Can not assign to invalid key 'nono'?"); - ok ++$test, exists $copy->{undef}, - "key 'undef' exists"; + is(exists $copy->{undef}, 1, "key 'undef' exists"); - ok ++$test, !defined $copy->{undef}, - "value for key 'undef' is undefined"; + is($copy->{undef}, undef, "value for key 'undef' is undefined"); } for $Storable::canonical (0, 1) { for my $cloner (\&dclone, \&freeze_thaw) { - print "# \$Storable::canonical = $Storable::canonical\n"; + note("\$Storable::canonical = $Storable::canonical"); testit (\%hash, $cloner); my $object = \%hash; # bless {}, "Restrict_Test"; @@ -119,11 +107,7 @@ for $Storable::canonical (0, 1) { for (0..16) { my $k = "k$_"; eval { $copy->{$k} = undef } ; - unless (ok ++$test, !$@, "Can assign to reserved key '$k'?") { - my $diag = $@; - $diag =~ s/\n.*\z//s; - print "# \$\@: $diag\n"; - } + is($@, '', "Can assign to reserved key '$k'?"); } } } diff --git a/dist/Storable/t/retrieve.t b/dist/Storable/t/retrieve.t index 2e44d5d..c41eb80 100644 --- a/dist/Storable/t/retrieve.t +++ b/dist/Storable/t/retrieve.t @@ -18,8 +18,7 @@ sub BEGIN { use Storable qw(store retrieve nstore); - -print "1..14\n"; +use Test::More tests => 14; $a = 'toto'; $b = \$a; @@ -29,41 +28,29 @@ $c->{attribute} = 'attrval'; @a = ('first', '', undef, 3, -4, -3.14159, 456, 4.5, $b, \$a, $a, $c, \$c, \%a); -print "not " unless defined store(\@a, 'store'); -print "ok 1\n"; -print "not " if Storable::last_op_in_netorder(); -print "ok 2\n"; -print "not " unless defined nstore(\@a, 'nstore'); -print "ok 3\n"; -print "not " unless Storable::last_op_in_netorder(); -print "ok 4\n"; -print "not " unless Storable::last_op_in_netorder(); -print "ok 5\n"; +isnt(store(\@a, 'store'), undef); +is(Storable::last_op_in_netorder(), ''); +isnt(nstore(\@a, 'nstore'), undef); +is(Storable::last_op_in_netorder(), 1); +is(Storable::last_op_in_netorder(), 1); $root = retrieve('store'); -print "not " unless defined $root; -print "ok 6\n"; -print "not " if Storable::last_op_in_netorder(); -print "ok 7\n"; +isnt($root, undef); +is(Storable::last_op_in_netorder(), ''); $nroot = retrieve('nstore'); -print "not " unless defined $nroot; -print "ok 8\n"; -print "not " unless Storable::last_op_in_netorder(); -print "ok 9\n"; +isnt($root, undef); +is(Storable::last_op_in_netorder(), 1); $d1 = &dump($root); -print "ok 10\n"; +isnt($d1, undef); $d2 = &dump($nroot); -print "ok 11\n"; +isnt($d2, undef); -print "not " unless $d1 eq $d2; -print "ok 12\n"; +is($d1, $d2); # Make sure empty string is defined at retrieval time -print "not " unless defined $root->[1]; -print "ok 13\n"; -print "not " if length $root->[1]; -print "ok 14\n"; +isnt($root->[1], undef); +is(length $root->[1], 0); END { 1 while unlink('store', 'nstore') } diff --git a/dist/Storable/t/sig_die.t b/dist/Storable/t/sig_die.t index d2390a7..70599c4 100644 --- a/dist/Storable/t/sig_die.t +++ b/dist/Storable/t/sig_die.t @@ -16,17 +16,7 @@ sub BEGIN { } use strict; -BEGIN { - if (!eval q{ - use Test::More; - 1; - }) { - print "1..0 # skip: tests only work with Test::More\n"; - exit; - } -} - -BEGIN { plan tests => 1 } +use Test::More tests => 1; my @warns; $SIG{__WARN__} = sub { push @warns, shift }; diff --git a/dist/Storable/t/st-dump.pl b/dist/Storable/t/st-dump.pl index 152b85a..4add560 100644 --- a/dist/Storable/t/st-dump.pl +++ b/dist/Storable/t/st-dump.pl @@ -5,35 +5,6 @@ # in the README file that comes with the distribution. # -# NOTE THAT THIS FILE IS COPIED FROM ext/Storable/t/st-dump.pl -# TO t/lib/st-dump.pl. One could also play games with -# File::Spec->updir and catdir to get the st-dump.pl in -# ext/Storable into @INC. - -sub ok { - my ($num, $ok, $name) = @_; - $num .= " - $name" if defined $name and length $name; - print $ok ? "ok $num\n" : "not ok $num\n"; - $ok; -} - -sub num_equal { - my ($num, $left, $right, $name) = @_; - my $ok = ((defined $left) ? $left == $right : undef); - unless (ok ($num, $ok, $name)) { - print "# Expected $right\n"; - if (!defined $left) { - print "# Got undef\n"; - } elsif ($left !~ tr/0-9//c) { - print "# Got $left\n"; - } else { - $left =~ s/([^-a-zA-Z0-9_+])/sprintf "\\%03o", ord $1/ge; - print "# Got \"$left\"\n"; - } - } - $ok; -} - package dump; use Carp; diff --git a/dist/Storable/t/tied.t b/dist/Storable/t/tied.t index 9a7f571..48eedab 100644 --- a/dist/Storable/t/tied.t +++ b/dist/Storable/t/tied.t @@ -16,11 +16,8 @@ sub BEGIN { require 'st-dump.pl'; } -sub ok; - use Storable qw(freeze thaw); - -print "1..23\n"; +use Test::More tests => 23; ($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0); @@ -147,16 +144,17 @@ $array[2] = \@array; @a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d, $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied); -ok 1, defined($f = freeze(\@a)); +my $f = freeze(\@a); +isnt($f, undef); $dumped = &dump(\@a); -ok 2, 1; +isnt($dumped, undef); $root = thaw($f); -ok 3, defined $root; +isnt($root, undef); $got = &dump($root); -ok 4, 1; +isnt($got, undef); ### Used to see the manifestation of the bug documented above. ### print "original: $dumped"; @@ -164,44 +162,42 @@ ok 4, 1; ### print "got: $got"; ### print "--------\n"; -ok 5, $got eq $dumped; +is($got, $dumped); $g = freeze($root); -ok 6, length($f) == length($g); +is(length $f, length $g); # Ensure the tied items in the retrieved image work @old = ($scalar_fetch, $array_fetch, $hash_fetch); @tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]}; @type = qw(SCALAR ARRAY HASH); -ok 7, tied $$tscalar; -ok 8, tied @{$tarray}; -ok 9, tied %{$thash}; +is(ref tied $$tscalar, 'TIED_SCALAR'); +is(ref tied @$tarray, 'TIED_ARRAY'); +is(ref tied %$thash, 'TIED_HASH'); @new = ($$tscalar, $tarray->[0], $thash->{'attribute'}); @new = ($scalar_fetch, $array_fetch, $hash_fetch); # Tests 10..15 for ($i = 0; $i < @new; $i++) { - print "not " unless $new[$i] == $old[$i] + 1; - printf "ok %d\n", 10 + 2*$i; # Tests 10,12,14 - print "not " unless ref $tied[$i] eq $type[$i]; - printf "ok %d\n", 11 + 2*$i; # Tests 11,13,15 + is($new[$i], $old[$i] + 1); + is(ref $tied[$i], $type[$i]); } # Check undef ties my $h = {}; tie $h->{'x'}, 'FAULT', $h, 'x'; my $hf = freeze($h); -ok 16, defined $hf; -ok 17, $FAULT::fault == 0; -ok 18, $h->{'x'} == 1; -ok 19, $FAULT::fault == 1; +isnt($hf, undef); +is($FAULT::fault, 0); +is($h->{'x'}, 1); +is($FAULT::fault, 1); my $ht = thaw($hf); -ok 20, defined $ht; -ok 21, $ht->{'x'} == 1; -ok 22, $FAULT::fault == 2; +isnt($ht, undef); +is($ht->{'x'}, 1); +is($FAULT::fault, 2); { package P; @@ -210,6 +206,6 @@ ok 22, $FAULT::fault == 2; $b = "not ok "; sub TIESCALAR { bless \$a } sub FETCH { "ok " } tie $a, P; my $r = thaw freeze \$a; $b = $$r; - print $b , 23, "\n"; + main::is($b, "ok "); } diff --git a/dist/Storable/t/tied_hook.t b/dist/Storable/t/tied_hook.t index 8f2846e..816e98a 100644 --- a/dist/Storable/t/tied_hook.t +++ b/dist/Storable/t/tied_hook.t @@ -16,11 +16,8 @@ sub BEGIN { require 'st-dump.pl'; } -sub ok; - use Storable qw(freeze thaw); - -print "1..25\n"; +use Test::More tests => 28; ($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0); @@ -162,48 +159,51 @@ $array[3] = "plaine scalaire"; @a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d, $b, \$a, $a, $c, \$c, \%a, \@array, \%hash, \@tied); -ok 1, defined($f = freeze(\@a)); - +my $f = freeze(\@a); +isnt($f, undef); $dumped = &dump(\@a); -ok 2, 1; +isnt($dumped, undef); $root = thaw($f); -ok 3, defined $root; +isnt($root, undef); $got = &dump($root); -ok 4, 1; +isnt($got, undef); -ok 5, $got ne $dumped; # our hooks did not handle refs in array +isnt($got, $dumped); # our hooks did not handle refs in array $g = freeze($root); -ok 6, length($f) == length($g); +is(length $f, length $g); # Ensure the tied items in the retrieved image work @old = ($scalar_fetch, $array_fetch, $hash_fetch); @tied = ($tscalar, $tarray, $thash) = @{$root->[$#{$root}]}; @type = qw(SCALAR ARRAY HASH); -ok 7, tied $$tscalar; -ok 8, tied @{$tarray}; -ok 9, tied %{$thash}; +is(ref tied $$tscalar, 'TIED_SCALAR'); +is(ref tied @$tarray, 'TIED_ARRAY'); +is(ref tied %$thash, 'TIED_HASH'); @new = ($$tscalar, $tarray->[0], $thash->{'attribute'}); @new = ($scalar_fetch, $array_fetch, $hash_fetch); # Tests 10..15 for ($i = 0; $i < @new; $i++) { - ok 10 + 2*$i, $new[$i] == $old[$i] + 1; # Tests 10,12,14 - ok 11 + 2*$i, ref $tied[$i] eq $type[$i]; # Tests 11,13,15 + is($new[$i], $old[$i] + 1); # Tests 10,12,14 + is(ref $tied[$i], $type[$i]); # Tests 11,13,15 } -ok 16, $$tscalar eq 'foo'; -ok 17, $tarray->[3] eq 'plaine scalaire'; -ok 18, $thash->{'attribute'} eq 'plain value'; +is($$tscalar, 'foo'); +is($tarray->[3], 'plaine scalaire'); +is($thash->{'attribute'}, 'plain value'); # Ensure hooks were called -ok 19, ($scalar_hook1 && $scalar_hook2); -ok 20, ($array_hook1 && $array_hook2); -ok 21, ($hash_hook1 && $hash_hook2); +is($scalar_hook1, 2); +is($scalar_hook2, 1); +is($array_hook1, 2); +is($array_hook2, 1); +is($hash_hook1, 2); +is($hash_hook2, 1); # # And now for the "blessed ref to tied hash" with "store hook" test... @@ -212,10 +212,10 @@ ok 21, ($hash_hook1 && $hash_hook2); my $bc = bless \%hash, 'FOO'; # FOO does not exist -> no hook my $bx = thaw freeze $bc; -ok 22, ref $bx eq 'FOO'; +is(ref $bx, 'FOO'); my $old_hash_fetch = $hash_fetch; my $v = $bx->{attribute}; -ok 23, $hash_fetch == $old_hash_fetch + 1; # Still tied +is($hash_fetch, $old_hash_fetch + 1, 'Still tied'); package TIED_HASH_REF; @@ -236,7 +236,7 @@ package main; $bc = bless \%hash, 'TIED_HASH_REF'; $bx = thaw freeze $bc; -ok 24, ref $bx eq 'TIED_HASH_REF'; +is(ref $bx, 'TIED_HASH_REF'); $old_hash_fetch = $hash_fetch; $v = $bx->{attribute}; -ok 25, $hash_fetch == $old_hash_fetch + 1; # Still tied +is($hash_fetch, $old_hash_fetch + 1, 'Still tied'); diff --git a/dist/Storable/t/tied_items.t b/dist/Storable/t/tied_items.t index 03e6cfe..ca43d46 100644 --- a/dist/Storable/t/tied_items.t +++ b/dist/Storable/t/tied_items.t @@ -17,15 +17,12 @@ sub BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } -sub ok; $^W = 0; -print "1..8\n"; - use Storable qw(dclone); +use Test::More tests => 8; $h_fetches = 0; @@ -37,10 +34,10 @@ tie %h, "H"; $ref = \$h{77}; $ref2 = dclone $ref; -ok 1, $h_fetches == 0; -ok 2, $$ref2 eq $$ref; -ok 3, $$ref2 == 7; -ok 4, $h_fetches == 2; +is($h_fetches, 0); +is($$ref2, $$ref); +is($$ref2, 7); +is($h_fetches, 2); $a_fetches = 0; @@ -52,8 +49,8 @@ tie @a, "A"; $ref = \$a[78]; $ref2 = dclone $ref; -ok 5, $a_fetches == 0; -ok 6, $$ref2 eq $$ref; -ok 7, $$ref2 == 8; +is($a_fetches, 0); +is($$ref2, $$ref); +is($$ref2, 8); # a bug in 5.12 and earlier caused an extra FETCH -ok 8, $a_fetches == 2 || $a_fetches == 3 ; +is($a_fetches, $] < 5.013 ? 3 : 2); diff --git a/dist/Storable/t/utf8.t b/dist/Storable/t/utf8.t index 67b7917..e4a6299 100644 --- a/dist/Storable/t/utf8.t +++ b/dist/Storable/t/utf8.t @@ -1,4 +1,3 @@ - #!./perl -w # # Copyright (c) 1995-2000, Raphael Manfredi @@ -18,41 +17,38 @@ sub BEGIN { print "1..0 # Skip: Storable was not built\n"; exit 0; } - require 'st-dump.pl'; } use strict; -sub ok; use Storable qw(thaw freeze); - -print "1..6\n"; +use Test::More tests => 6; my $x = chr(1234); -ok 1, $x eq ${thaw freeze \$x}; +is($x, ${thaw freeze \$x}); # Long scalar $x = join '', map {chr $_} (0..1023); -ok 2, $x eq ${thaw freeze \$x}; +is($x, ${thaw freeze \$x}); # Char in the range 127-255 (probably) in utf8 $x = chr (175) . chr (256); chop $x; -ok 3, $x eq ${thaw freeze \$x}; +is($x, ${thaw freeze \$x}); # Storable needs to cope if a frozen string happens to be internall utf8 # encoded $x = chr 256; my $data = freeze \$x; -ok 4, $x eq ${thaw $data}; +is($x, ${thaw $data}); $data .= chr 256; chop $data; -ok 5, $x eq ${thaw $data}; +is($x, ${thaw $data}); $data .= chr 256; # This definately isn't valid eval {thaw $data}; -ok 6, $@ =~ /corrupt.*characters outside/; +like($@, qr/corrupt.*characters outside/); -- 2.7.4