use strict;
BEGIN {
if (!eval q{
- use Test;
+ use Test::More;
use B::Deparse 0.61;
use 5.006;
1;
\&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},
$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
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]));
######################################################################
$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
$freezed = freeze $obj[$i];
$@ = "";
eval { $thawed = thaw $freezed };
- ok($@, qr/Can\'t eval/);
+ like($@, qr/Can\'t eval/);
}
}
for my $i (0 .. 1) {
$@ = "";
eval { $freezed = freeze $obj[$i] };
- ok($@, qr/Can\'t store CODE items/);
+ like($@, qr/Can\'t store CODE items/);
}
}
$freezed = freeze $obj[0]->[$i];
$@ = "";
eval { $thawed = thaw $freezed };
- ok($@, "");
- ok($$thawed, qr/^sub/);
+ is($@, "");
+ like($$thawed, qr/^sub/);
}
}
open(STDERR, ">&SAVEERR");
- ok($@, "");
- ok($freezed ne '');
+ is($@, "");
+ isnt($freezed, '');
}
{
$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
substr($freezed, -1, 0, $bad_code);
$@ = "";
eval { $thawed = thaw $freezed };
- ok($@, qr/(trapped|Code sub)/);
+ like($@, qr/(trapped|Code sub)/);
}
}
$freezed = freeze $obj[0]->[1];
$@ = "";
eval { $thawed = thaw $freezed };
- ok($@, "");
- ok($thawed->(), 42);
+ is($@, "");
+ is($thawed->(), 42);
}
{
$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]));
}
}
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]));
}
}
use strict;
BEGIN {
if (!eval q{
- use Test;
+ use Test::More;
use B::Deparse 0.61;
use 5.006;
1;
$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;
#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;
#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");
#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");
#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");
#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 {