This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert all Storable's tests to use Test::More.
authorNicholas Clark <nick@ccl4.org>
Fri, 10 Dec 2010 14:38:52 +0000 (14:38 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 10 Dec 2010 14:54:39 +0000 (14:54 +0000)
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.

18 files changed:
dist/Storable/t/blessed.t
dist/Storable/t/canonical.t
dist/Storable/t/compat01.t
dist/Storable/t/compat06.t
dist/Storable/t/dclone.t
dist/Storable/t/forgive.t
dist/Storable/t/freeze.t
dist/Storable/t/lock.t
dist/Storable/t/overload.t
dist/Storable/t/recurse.t
dist/Storable/t/restrict.t
dist/Storable/t/retrieve.t
dist/Storable/t/sig_die.t
dist/Storable/t/st-dump.pl
dist/Storable/t/tied.t
dist/Storable/t/tied_hook.t
dist/Storable/t/tied_items.t
dist/Storable/t/utf8.t

index b8ae067..9bc9512 100644 (file)
@@ -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 <<EOC;
 package ${name}_WITH_HOOK;
 
 \@ISA = ("SHORT_NAME_WITH_HOOK");
 EOC
-ok 2, $@ eq '';
+is($@, '');
 
 # Construct a pool of objects
 my @pool;
@@ -82,16 +80,16 @@ for (my $i = 0; $i < 10; $i++) {
 }
 
 my $x = freeze \@pool;
-ok 3, 1;
+pass("Freeze didn't crash");
 
 my $y = thaw $x;
-ok 4, ref $y eq 'ARRAY';
-ok 5, @{$y} == @pool;
+is(ref $y, 'ARRAY');
+is(scalar @{$y}, @pool);
 
-ok 6, ref $y->[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');
index 204a235..034ac08 100644 (file)
@@ -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});
index 9b47212..f234916 100644 (file)
@@ -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);
 }
index 6d8ade3..758a500 100644 (file)
@@ -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__
 #
index 078cd81..74d1b5c 100644 (file)
@@ -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 <<EOF;
-ok 11 # skip No Tie::StdHash available
-ok 12 # skip No Tie::StdHash available
-EOF
+    is($clone_hash->{1}, $tie{hash}{1});
 }
index 495edc3..d65f3bc 100644 (file)
@@ -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' }
index e76b669..bc3babc 100644 (file)
@@ -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");
 }
index 14b5f42..3183243 100644 (file)
@@ -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';
 
index 22fccfb..e3e4837 100644 (file)
@@ -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");
 
 }
 
index d7dcb0e..bc34d73 100644 (file)
@@ -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 <sog@msg.com.mx>
@@ -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);
index be7f408..20e8165 100644 (file)
@@ -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'?");
     }
   }
 }
index 2e44d5d..c41eb80 100644 (file)
@@ -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') }
index d2390a7..70599c4 100644 (file)
@@ -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 };
index 152b85a..4add560 100644 (file)
@@ -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;
 
index 9a7f571..48eedab 100644 (file)
@@ -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 ");
 }
 
index 8f2846e..816e98a 100644 (file)
@@ -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');
index 03e6cfe..ca43d46 100644 (file)
@@ -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);
index 67b7917..e4a6299 100644 (file)
@@ -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/);