From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 23 Oct 2009 19:58:28 +0000 (+0100)
Subject: Convert the 2 Storable tests that use Test to use Test::More.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3513da74e0f2c30b5ec85278b6e69f8751be9184;p=p5sagit%2Fp5-mst-13.2.git

Convert the 2 Storable tests that use Test to use Test::More.
---

diff --git a/dist/Storable/t/code.t b/dist/Storable/t/code.t
index dd2a96e..a51dffc 100644
--- a/dist/Storable/t/code.t
+++ b/dist/Storable/t/code.t
@@ -18,7 +18,7 @@ sub BEGIN {
 use strict;
 BEGIN {
     if (!eval q{
-	use Test;
+	use Test::More;
 	use B::Deparse 0.61;
 	use 5.006;
 	1;
@@ -59,7 +59,7 @@ local *FOO;
       \&Another::Package::foo,  # code in another package
       sub ($$;$) { 0 },         # prototypes
       sub { print "test\n" },
-      \&Test::ok,               # large scalar
+      \&Test::More::ok,               # large scalar
      ],
 
      {"a" => sub { "srt" }, "b" => \&code},
@@ -82,44 +82,44 @@ $Storable::Eval    = 1;
 $freezed = freeze $obj[0];
 $thawed  = thaw $freezed;
 
-ok($thawed->[0]->(), "JAPH");
-ok($thawed->[1]->(), 42);
-ok($thawed->[2]->(), "blessed");
-ok($thawed->[3]->(), "Another::Package");
-ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
+is($thawed->[0]->(), "JAPH");
+is($thawed->[1]->(), 42);
+is($thawed->[2]->(), "blessed");
+is($thawed->[3]->(), "Another::Package");
+is(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
 ######################################################################
 
 $freezed = freeze $obj[1];
 $thawed  = thaw $freezed;
 
-ok($thawed->{"a"}->(), "srt");
-ok($thawed->{"b"}->(), "JAPH");
+is($thawed->{"a"}->(), "srt");
+is($thawed->{"b"}->(), "JAPH");
 
 ######################################################################
 
 $freezed = freeze $obj[2];
 $thawed  = thaw $freezed;
 
-ok($thawed->(), 42);
+is($thawed->(), 42);
 
 ######################################################################
 
 $freezed = freeze $obj[3];
 $thawed  = thaw $freezed;
 
-ok($thawed->(), "JAPH");
+is($thawed->(), "JAPH");
 
 ######################################################################
 
 eval { $freezed = freeze $obj[4] };
-ok($@, qr/The result of B::Deparse::coderef2text was empty/);
+like($@, qr/The result of B::Deparse::coderef2text was empty/);
 
 ######################################################################
 # Test dclone
 
 my $new_sub = dclone($obj[2]);
-ok($new_sub->(), $obj[2]->());
+is($new_sub->(), $obj[2]->());
 
 ######################################################################
 # Test retrieve & store
@@ -127,11 +127,11 @@ ok($new_sub->(), $obj[2]->());
 store $obj[0], 'store';
 $thawed = retrieve 'store';
 
-ok($thawed->[0]->(), "JAPH");
-ok($thawed->[1]->(), 42);
-ok($thawed->[2]->(), "blessed");
-ok($thawed->[3]->(), "Another::Package");
-ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
+is($thawed->[0]->(), "JAPH");
+is($thawed->[1]->(), 42);
+is($thawed->[2]->(), "blessed");
+is($thawed->[3]->(), "Another::Package");
+is(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
 ######################################################################
 
@@ -139,11 +139,11 @@ nstore $obj[0], 'store';
 $thawed = retrieve 'store';
 unlink 'store';
 
-ok($thawed->[0]->(), "JAPH");
-ok($thawed->[1]->(), 42);
-ok($thawed->[2]->(), "blessed");
-ok($thawed->[3]->(), "Another::Package");
-ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
+is($thawed->[0]->(), "JAPH");
+is($thawed->[1]->(), 42);
+is($thawed->[2]->(), "blessed");
+is($thawed->[3]->(), "Another::Package");
+is(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
 ######################################################################
 # Security with
@@ -157,7 +157,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	$freezed = freeze $obj[$i];
 	$@ = "";
 	eval { $thawed  = thaw $freezed };
-	ok($@, qr/Can\'t eval/);
+	like($@, qr/Can\'t eval/);
     }
 }
 
@@ -167,7 +167,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
     for my $i (0 .. 1) {
 	$@ = "";
 	eval { $freezed = freeze $obj[$i] };
-	ok($@, qr/Can\'t store CODE items/);
+	like($@, qr/Can\'t store CODE items/);
     }
 }
 
@@ -178,8 +178,8 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	$freezed = freeze $obj[0]->[$i];
 	$@ = "";
 	eval { $thawed  = thaw $freezed };
-	ok($@, "");
-	ok($$thawed, qr/^sub/);
+	is($@, "");
+	like($$thawed, qr/^sub/);
     }
 }
 
@@ -197,8 +197,8 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
     open(STDERR, ">&SAVEERR");
 
-    ok($@, "");
-    ok($freezed ne '');
+    is($@, "");
+    isnt($freezed, '');
 }
 
 {
@@ -208,13 +208,13 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
     $freezed = freeze $obj[0]->[0];
     $@ = "";
     eval { $thawed = thaw $freezed };
-    ok($@, "");
-    ok($thawed->(), "JAPH");
+    is($@, "");
+    is($thawed->(), "JAPH");
 
     $freezed = freeze $obj[0]->[6];
     eval { $thawed = thaw $freezed };
     # The "Code sub ..." error message only appears if Log::Agent is installed
-    ok($@, qr/(trapped|Code sub)/);
+    like($@, qr/(trapped|Code sub)/);
 
     if (0) {
 	# Disable or fix this test if the internal representation of Storable
@@ -230,7 +230,7 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	substr($freezed, -1, 0, $bad_code);
 	$@ = "";
 	eval { $thawed = thaw $freezed };
-	ok($@, qr/(trapped|Code sub)/);
+	like($@, qr/(trapped|Code sub)/);
     }
 }
 
@@ -243,8 +243,8 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
     $freezed = freeze $obj[0]->[1];
     $@ = "";
     eval { $thawed = thaw $freezed };
-    ok($@, "");
-    ok($thawed->(), 42);
+    is($@, "");
+    is($thawed->(), 42);
 }
 
 {
@@ -265,16 +265,16 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
     $freezed = freeze $obj[0];
     eval { $thawed  = thaw $freezed };
-    ok($@, "");
+    is($@, "");
 
     if ($@ ne "") {
-        ok(0) for (1..5);
+        fail() for (1..5);
     } else {
-	ok($thawed->[0]->(), "JAPH");
-	ok($thawed->[1]->(), 42);
-	ok($thawed->[2]->(), "blessed");
-	ok($thawed->[3]->(), "Another::Package");
-	ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
+	is($thawed->[0]->(), "JAPH");
+	is($thawed->[1]->(), 42);
+	is($thawed->[2]->(), "blessed");
+	is($thawed->[3]->(), "Another::Package");
+	is(prototype($thawed->[4]), prototype($obj[0]->[4]));
     }
 }
 
@@ -293,15 +293,15 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 	my $res;
 
 	$res = thaw freeze [$sub, $sub];
-	ok(int($res->[0]), int($res->[1]));
+	is(int($res->[0]), int($res->[1]));
 
 	$res = thaw freeze [$sclr, $sub, $sub, $sclr];
-	ok(int($res->[0]), int($res->[3]));
-	ok(int($res->[1]), int($res->[2]));
+	is(int($res->[0]), int($res->[3]));
+	is(int($res->[1]), int($res->[2]));
 
 	$res = thaw freeze [$sub, $sub, $sclr, $sclr];
-	ok(int($res->[0]), int($res->[1]));
-	ok(int($res->[2]), int($res->[3]));
+	is(int($res->[0]), int($res->[1]));
+	is(int($res->[2]), int($res->[3]));
     }
 
 }
diff --git a/dist/Storable/t/just_plain_nasty.t b/dist/Storable/t/just_plain_nasty.t
index 85eaa90..28fa7e0 100644
--- a/dist/Storable/t/just_plain_nasty.t
+++ b/dist/Storable/t/just_plain_nasty.t
@@ -17,7 +17,7 @@ sub BEGIN {
 use strict;
 BEGIN {
     if (!eval q{
-        use Test;
+        use Test::More;
         use B::Deparse 0.61;
         use 5.006;
         1;
@@ -64,7 +64,7 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
 
     $a[$dbun]->[0] = $a[0];
 
-    ok(ref($nasty), "ARRAY", "Sanity found (now to play with it :->)");
+    is(ref($nasty), "ARRAY", "Sanity found (now to play with it :->)");
 
     $Storable::Deparse = $Storable::Deparse = 1;
     $Storable::Eval = $Storable::Eval = 1;
@@ -74,16 +74,16 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
     #print $icicle;   # cat -ve recommended :)
     headit("circular overload 1 - thaw");
     my $oh_dear = thaw $icicle;
-    ok(ref($oh_dear), "ARRAY", "dclone - circular overload");
-    ok($oh_dear->[0], "keep it so", "amagic ok 1");
-    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+    is(ref($oh_dear), "ARRAY", "dclone - circular overload");
+    is($oh_dear->[0], "keep it so", "amagic ok 1");
+    is($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
 
     headit("closure dclone - freeze");
     $icicle = freeze sub { "two" };
     #print $icicle;
     headit("closure dclone - thaw");
     my $sub2 = thaw $icicle;
-    ok($sub2->(), "two", "closures getting dcloned OK");
+    is($sub2->(), "two", "closures getting dcloned OK");
 
     headit("circular overload, after closure - freeze");
     #use Data::Dumper;
@@ -92,9 +92,9 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
     #print $icicle;
     headit("circular overload, after closure - thaw");
     $oh_dear = thaw $icicle;
-    ok(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
-    ok($oh_dear->[0], "keep it so", "amagic ok 1");
-    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+    is(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
+    is($oh_dear->[0], "keep it so", "amagic ok 1");
+    is($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
 
     push @{$nasty}, sub { print "Goodbye, cruel world.\n" };
     headit("closure freeze AFTER circular overload");
@@ -103,9 +103,9 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
     #print $icicle;
     headit("circular thaw AFTER circular overload");
     $oh_dear = thaw $icicle;
-    ok(ref($oh_dear), "ARRAY", "dclone - before a closure dclone");
-    ok($oh_dear->[0], "keep it so", "amagic ok 1");
-    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+    is(ref($oh_dear), "ARRAY", "dclone - before a closure dclone");
+    is($oh_dear->[0], "keep it so", "amagic ok 1");
+    is($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
 
     @{$nasty} = @{$nasty}[0, 2, 1];
     headit("closure freeze BETWEEN circular overload");
@@ -114,9 +114,9 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
     #print $icicle;
     headit("circular thaw BETWEEN circular overload");
     $oh_dear = thaw $icicle;
-    ok(ref($oh_dear), "ARRAY", "dclone - between a closure dclone");
-    ok($oh_dear->[0], "keep it so", "amagic ok 1");
-    ok($oh_dear->[$dbun?2:0]->[0], "keep it so", "amagic ok 2");
+    is(ref($oh_dear), "ARRAY", "dclone - between a closure dclone");
+    is($oh_dear->[0], "keep it so", "amagic ok 1");
+    is($oh_dear->[$dbun?2:0]->[0], "keep it so", "amagic ok 2");
 
     @{$nasty} = @{$nasty}[1, 0, 2];
     headit("closure freeze BEFORE circular overload");
@@ -125,9 +125,9 @@ for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
     #print $icicle;
     headit("circular thaw BEFORE circular overload");
     $oh_dear = thaw $icicle;
-    ok(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
-    ok($oh_dear->[1], "keep it so", "amagic ok 1");
-    ok($oh_dear->[$dbun+1]->[0], "keep it so", "amagic ok 2");
+    is(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
+    is($oh_dear->[1], "keep it so", "amagic ok 1");
+    is($oh_dear->[$dbun+1]->[0], "keep it so", "amagic ok 2");
 }
 
 sub headit {