I've switched over to using is() for anything that wasn't an '==' test'
on funky
numeric values; there are a lot of those in (e.g.) bop.t, and I didn't
want to
change the fundamental nature of the tests. I've also gotten my diff format
right this time. :)
So here are:
- avhv.t
- bop.t
- chars.t
- closure.t (only a short patch; I wasn't up to rewriting all of Tom's
code. It does remove the print "not " stuff, though)
- concat.t
- defins.t
- delete.t
- die.t (this looked nasty to switch to Test::More. so I just fixed the
prints)
- die_exit.t (similar to die.t)
Still working my way through t/op; hope to have more later today.
--- Joe M.
--- ../op/avhv.t Mon Apr 23 18:43:40 2001
+++ avhv.t Thu Aug 30 10:30:26 2001
@@ -17,7 +17,9 @@
package main;
-print "1..29\n";
+use Test::More tests=>29;
+
+my $test = 1;
$sch = {
'abc' => 1,
@@ -36,7 +38,7 @@
@keys = keys %$a;
@values = values %$a;
-if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
+ok($#keys == 2 && $#values == 2, "key/value count");
$i = 0; # stop -w complaints
@@ -47,7 +49,7 @@
}
}
-if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
+is($i, 3, "each()");
# quick check with tied array
tie @fake, 'Tie::StdArray';
@@ -55,7 +57,7 @@
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
+is($a->{'abc'}, 'ABC', "Tie::StdArray");
# quick check with tied array
tie @fake, 'Tie::BasicArray';
@@ -63,7 +65,7 @@
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
+is($a->{'abc'}, 'ABC', "Tie::BasicArray");
# quick check with tied array & tied hash
require Tie::Hash;
@@ -72,113 +74,96 @@
$a->[0] = \%fake;
$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
+is($a->{'abc'}, 'ABC', "Tie::StdHash failure");
# hash slice
my $slice = join('', 'x',@$a{'abc','def'},'x');
-print "not " if $slice ne 'xABCx';
-print "ok 6\n";
+is($slice, 'xABCx', "hash slice");
# evaluation in scalar context
my $avhv = [{}];
-print "not " if %$avhv;
-print "ok 7\n";
+ok(!%$avhv, "empty scalar context");
+
push @$avhv, "a";
-print "not " if %$avhv;
-print "ok 8\n";
+ok(!%$avhv, "single scalar context");
$avhv = [];
eval { $a = %$avhv };
-print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
-print "ok 9\n";
+ok(($@ and $@ =~ /^Can't coerce array into hash/),"hash coercion");
$avhv = [{foo=>1, bar=>2}];
-print "not " unless %$avhv =~ m,^\d+/\d+,;
-print "ok 10\n";
+ok(%$avhv =~ m{^\d+/\d+}, "hash in scalar context");
# check if defelem magic works
sub f {
- print "not " unless $_[0] eq 'a';
+ my $failed = 0;
+ ok($_[0] eq 'a', '@_ ok in defelem check')
+ or $failed = 1;
$_[0] = 'b';
- print "ok 11\n";
}
$a = [{key => 1}, 'a'];
-f($a->{key});
-print "not " unless $a->[1] eq 'b';
-print "ok 12\n";
+ok(f($a->{key}) && $a->[1] eq 'b',
+ "defelem magic");
# check if exists() is behaving properly
$avhv = [{foo=>1,bar=>2,pants=>3}];
-print "not " if exists $avhv->{bar};
-print "ok 13\n";
+ok(!exists $avhv->{bar}, "exists() with subhash");
$avhv->{pants} = undef;
-print "not " unless exists $avhv->{pants};
-print "ok 14\n";
-print "not " if exists $avhv->{bar};
-print "ok 15\n";
+ok(exists $avhv->{pants}, "exists() with undef assignment");
+ok(!exists $avhv->{bar}, "exists() after undef assignment");
$avhv->{bar} = 10;
-print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
-print "ok 16\n";
+ok((exists $avhv->{bar} and $avhv->{bar} == 10),
+ "hash reassignment");
$v = delete $avhv->{bar};
-print "not " unless $v == 10;
-print "ok 17\n";
-
-print "not " if exists $avhv->{bar};
-print "ok 18\n";
+ok($v == 10, "delete() value check");
+ok(!exists $avhv->{bar}, "exists() after delete()");
$avhv->{foo} = 'xxx';
$avhv->{bar} = 'yyy';
$avhv->{pants} = 'zzz';
@x = delete @{$avhv}{'foo','pants'};
-print "# @x\nnot " unless "@x" eq "xxx zzz";
-print "ok 19\n";
-
-print "not " unless "$avhv->{bar}" eq "yyy";
-print "ok 20\n";
+ok("@x" eq "xxx zzz", "slice delete");
+ok("$avhv->{bar}" eq "yyy", "check after slice delete");
# hash assignment
%$avhv = ();
-print "not " unless ref($avhv->[0]) eq 'HASH';
-print "ok 21\n";
+ok(ref($avhv->[0]) eq 'HASH', "hash assignment");
%hv = %$avhv;
-print "not " if grep defined, values %hv;
-print "ok 22\n";
-print "not " if grep ref, keys %hv;
-print "ok 23\n";
+ok(!grep(defined, values %hv), "grep defined(), empty hash");
+ok(!grep(ref, keys %hv), "grep ref(), empty hash");
%$avhv = (foo => 29, pants => 2, bar => 0);
-print "not " unless "@$avhv[1..3]" eq '29 0 2';
-print "ok 24\n";
+ok("@$avhv[1..3]" eq '29 0 2', "array deref");
my $extra;
my @extra;
($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo';
-print "ok 25\n";
+ok(("@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo'),
+ "proper distribution, list assign");
%$avhv = ();
(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra;
-print "ok 26\n";
+ok(("@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra),
+ "undef assign from list to scalar");
@extra = qw(whatever and stuff);
%$avhv = ();
(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0;
-print "ok 27\n";
+ok(("@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0),
+ "undef assign from list to array");
%$avhv = ();
(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless ref $avhv->[0] eq 'HASH' and @extra == 6;
-print "ok 28\n";
+ok((ref $avhv->[0] eq 'HASH' and @extra == 6),
+ "undef assign from list to hash");
# Check hash slices (BUG ID 20010423.002)
$avhv = [{foo=>1, bar=>2}];
@$avhv{"foo", "bar"} = (42, 53);
-print "not " unless $avhv->{foo} == 42 && $avhv->{bar} == 53;
-print "ok 29\n";
+ok($avhv->{foo} == 42 && $avhv->{bar} == 53,
+ "hash slice assign from list");
--- ../op/bop.t Thu Mar 29 09:21:18 2001
+++ bop.t Thu Aug 30 10:34:17 2001
@@ -9,91 +9,98 @@
@INC = '../lib';
}
-print "1..44\n";
+use Test::More tests=>44;
# numerics
-print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
-print ((0xdead | 0xbeef) == 0xfeef ? "ok 2\n" : "not ok 2\n");
-print ((0xdead ^ 0xbeef) == 0x6042 ? "ok 3\n" : "not ok 3\n");
-print ((~0xdead & 0xbeef) == 0x2042 ? "ok 4\n" : "not ok 4\n");
+ok( (0xdead & 0xbeef) == 0x9ead, "&");
+ok( (0xdead | 0xbeef) == 0xfeef, "|");
+
+ok( (0xdead ^ 0xbeef) == 0x6042, "^");
+ok( (~0xdead & 0xbeef) == 0x2042, "~");
+
# shifts
-print ((257 << 7) == 32896 ? "ok 5\n" : "not ok 5\n");
-print ((33023 >> 7) == 257 ? "ok 6\n" : "not ok 6\n");
+ok((257 << 7) == 32896, "<<");
+ok((33023 >> 7) == 257, ">>");
# signed vs. unsigned
-print ((~0 > 0 && do { use integer; ~0 } == -1)
- ? "ok 7\n" : "not ok 7\n");
+ok((~0 > 0 && do { use integer; ~0 } == -1), "~0, signed");
my $bits = 0;
for (my $i = ~0; $i; $i >>= 1) { ++$bits; }
my $cusp = 1 << ($bits - 1);
-print ((($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0)
- ? "ok 8\n" : "not ok 8\n");
-print ((($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0)
- ? "ok 9\n" : "not ok 9\n");
-print ((($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0)
- ? "ok 10\n" : "not ok 10\n");
-print (((1 << ($bits - 1)) == $cusp &&
- do { use integer; 1 << ($bits - 1) } == -$cusp)
- ? "ok 11\n" : "not ok 11\n");
-print ((($cusp >> 1) == ($cusp / 2) &&
- do { use integer; abs($cusp >> 1) } == ($cusp / 2))
- ? "ok 12\n" : "not ok 12\n");
+ok((($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0), "&, signed");
+ok((($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0), "|, signed");
+ok((($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0), "^, signed");
+ok(((1 << ($bits - 1)) == $cusp &&
+ do { use integer; 1 << ($bits - 1) } == -$cusp), "<<, signed");
+ok((($cusp >> 1) == ($cusp / 2) &&
+ do { use integer; abs($cusp >> 1) } == ($cusp / 2)), ">>, signed");
$Aaz = chr(ord("A") & ord("z"));
$Aoz = chr(ord("A") | ord("z"));
$Axz = chr(ord("A") ^ ord("z"));
# short strings
-print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
-print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
-print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
+ok(("AAAAA" & "zzzzz") eq ($Aaz x 5), "&, short strings");
+ok(("AAAAA" | "zzzzz") eq ($Aoz x 5), "|, short strings");
+ok(("AAAAA" ^ "zzzzz") eq ($Axz x 5), "^, short strings");
# long strings
$foo = "A" x 150;
$bar = "z" x 75;
$zap = "A" x 75;
# & truncates
-print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+ok(($foo & $bar) eq ($Aaz x 75 ), "long strings - & truncation");
# | does not truncate
-print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+ok(($foo | $bar) eq ($Aoz x 75 . $zap), "long strings, | no truncation");
# ^ does not truncate
-print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+ok(($foo ^ $bar) eq ($Axz x 75 . $zap), "long strings, ^ no truncation");
#
-print "ok \xFF\xFF\n" & "ok 19\n";
-print "ok 20\n" | "ok \0\0\n";
-print "o\000 \0001\000" ^ "\000k\0002\000\n";
+ok(("ok \xFF\xFF\n" & "ok 19\n") eq "ok 19\n", '& \xFF');
+ok(("ok \x00\x00\n" | "ok 20\n") eq "ok 20\n", '| \x00');
+
+ok(("o\000 \0001\000" ^ "\000k\0002\000\n") eq "ok 21\n", "^ crossed octals");
#
-print "ok \x{FF}\x{FF}\n" & "ok 22\n";
-print "ok 23\n" | "ok \x{0}\x{0}\n";
-print "o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n";
+ok(("ok \x{FF}\x{FF}\n" & "ok 22\n") eq "ok 22\n", '& \x{FF}');
+ok(("ok 23\n" | "ok \x{0}\x{0}\n") eq "ok 23\n", '| \x{0}');
+
+ok(("o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n") eq "ok 24\n", '^\x{0}');
+
+# More variations on 19 and 22.
+ok(("ok \xFF\x{FF}\n" & "ok 41\n") eq "ok 41\n", '&, \xFF\x{FF}');
+ok(("ok \x{FF}\xFF\n" & "ok 42\n") eq "ok 42\n", '&, \x{FF}\xFF');
+
#
-print "ok 25\n" if sprintf("%vd", v4095 & v801) eq 801;
-print "ok 26\n" if sprintf("%vd", v4095 | v801) eq 4095;
-print "ok 27\n" if sprintf("%vd", v4095 ^ v801) eq 3294;
+ok(sprintf("%vd", v4095 & v801) eq 801, "& basic vstrings");
+ok(sprintf("%vd", v4095 | v801) eq 4095, "| basic vstrings");
+ok(sprintf("%vd", v4095 ^ v801) eq 3294, "^ basic vstrings");
#
-print "ok 28\n" if sprintf("%vd", v4095.801.4095 & v801.4095) eq '801.801';
-print "ok 29\n" if sprintf("%vd", v4095.801.4095 | v801.4095) eq '4095.4095.4095';
-print "ok 30\n" if sprintf("%vd", v801.4095 ^ v4095.801.4095) eq '3294.3294.4095';
+ok(sprintf("%vd", v4095.801.4095 & v801.4095) eq '801.801',
+ "& vstrings overlap");
+ok(sprintf("%vd", v4095.801.4095 | v801.4095) eq '4095.4095.4095',
+ "| vstrings overlap");
+ok(sprintf("%vd", v801.4095 ^ v4095.801.4095) eq '3294.3294.4095',
+ "^ vstrings overlap");
#
-print "ok 31\n" if sprintf("%vd", v120.300 & v200.400) eq '72.256';
-print "ok 32\n" if sprintf("%vd", v120.300 | v200.400) eq '248.444';
-print "ok 33\n" if sprintf("%vd", v120.300 ^ v200.400) eq '176.188';
+ok(sprintf("%vd", v120.300 & v200.400) eq '72.256', "& dotted vstrings");
+ok(sprintf("%vd", v120.300 | v200.400) eq '248.444', "| dotted vstrings");
+ok(sprintf("%vd", v120.300 ^ v200.400) eq '176.188', "^ dotted vstrings");
#
my $a = v120.300;
my $b = v200.400;
$a ^= $b;
-print "ok 34\n" if sprintf("%vd", $a) eq '176.188';
+ok(sprintf("%vd", $a) eq '176.188', "^= scalar vstrings");
+
my $a = v120.300;
my $b = v200.400;
$a |= $b;
-print "ok 35\n" if sprintf("%vd", $a) eq '248.444';
+ok(sprintf("%vd", $a) eq '248.444', "|= scalar vstrings");
#
# UTF8 ~ behaviour
@@ -114,11 +121,7 @@
if $a ne chr(~$_) or length($a) != 1 or ~$a ne chr($_);
}
}
-if (@not36) {
- print "# test 36 failed\n";
- print "not ";
-}
-print "ok 36\n";
+ok(!@not36, 'UTF8 ~, 1-byte chars');
my @not37;
@@ -138,28 +141,20 @@
}
}
}
-if (@not37) {
- print "# test 37 failed\n";
- print "not ";
-}
-print "ok 37\n";
+ok(!@not37, "UTF8 ~, 2-byte chars");
-print "not " unless ~chr(~0) eq "\0" or $Is_EBCDIC;
-print "ok 38\n";
+ok((~chr(~0) eq "\0" or $Is_EBCDIC), "double ~ chr(0)");
my @not39;
+# DeMorgan's Law tests.
for my $i (0x100..0x120) {
for my $j (0x100...0x120) {
push @not39, sprintf("%#03X %#03X", $i, $j)
if ~(chr($i)|chr($j)) ne (~chr($i)&~chr($j));
}
}
-if (@not39) {
- print "# test 39 failed\n";
- print "not ";
-}
-print "ok 39\n";
+ok(!@not39, "UTF8 DeMorgan: | equivalence to ~&~");
my @not40;
@@ -169,18 +164,11 @@
if ~(chr($i)&chr($j)) ne (~chr($i)|~chr($j));
}
}
-if (@not40) {
- print "# test 40 failed\n";
- print "not ";
-}
-print "ok 40\n";
-
-# More variations on 19 and 22.
-print "ok \xFF\x{FF}\n" & "ok 41\n";
-print "ok \x{FF}\xFF\n" & "ok 42\n";
+ok(!@not40, "UTF8 DeMorgan: & equivalence to ~|~");
# Tests to see if you really can do casts negative floats to unsigned properly
$neg1 = -1.0;
-print ((~ $neg1 == 0) ? "ok 43\n" : "not ok 43\n");
+ok(~ $neg1 == 0, "float casting: ~ -1.0 == 0");
$neg7 = -7.0;
-print ((~ $neg7 == 6) ? "ok 44\n" : "not ok 44\n");
+ok(~ $neg7 == 6, "float casting: ~ -7.0 == 6");
+
--- ../op/chars.t Mon Jul 31 22:32:13 2000
+++ chars.t Wed Aug 29 12:58:38 2001
@@ -1,74 +1,41 @@
#!./perl
-print "1..33\n";
+use Test::More tests=>33;
-# because of ebcdic.c these should be the same on asciiish
+# because of ebcdic.c these should be the same on asciiish
# and ebcdic machines.
# Peter Prymmer <[EMAIL PROTECTED]>.
-
-my $c = "\c@";
-print +((ord($c) == 0) ? "" : "not "),"ok 1\n";
-$c = "\cA";
-print +((ord($c) == 1) ? "" : "not "),"ok 2\n";
-$c = "\cB";
-print +((ord($c) == 2) ? "" : "not "),"ok 3\n";
-$c = "\cC";
-print +((ord($c) == 3) ? "" : "not "),"ok 4\n";
-$c = "\cD";
-print +((ord($c) == 4) ? "" : "not "),"ok 5\n";
-$c = "\cE";
-print +((ord($c) == 5) ? "" : "not "),"ok 6\n";
-$c = "\cF";
-print +((ord($c) == 6) ? "" : "not "),"ok 7\n";
-$c = "\cG";
-print +((ord($c) == 7) ? "" : "not "),"ok 8\n";
-$c = "\cH";
-print +((ord($c) == 8) ? "" : "not "),"ok 9\n";
-$c = "\cI";
-print +((ord($c) == 9) ? "" : "not "),"ok 10\n";
-$c = "\cJ";
-print +((ord($c) == 10) ? "" : "not "),"ok 11\n";
-$c = "\cK";
-print +((ord($c) == 11) ? "" : "not "),"ok 12\n";
-$c = "\cL";
-print +((ord($c) == 12) ? "" : "not "),"ok 13\n";
-$c = "\cM";
-print +((ord($c) == 13) ? "" : "not "),"ok 14\n";
-$c = "\cN";
-print +((ord($c) == 14) ? "" : "not "),"ok 15\n";
-$c = "\cO";
-print +((ord($c) == 15) ? "" : "not "),"ok 16\n";
-$c = "\cP";
-print +((ord($c) == 16) ? "" : "not "),"ok 17\n";
-$c = "\cQ";
-print +((ord($c) == 17) ? "" : "not "),"ok 18\n";
-$c = "\cR";
-print +((ord($c) == 18) ? "" : "not "),"ok 19\n";
-$c = "\cS";
-print +((ord($c) == 19) ? "" : "not "),"ok 20\n";
-$c = "\cT";
-print +((ord($c) == 20) ? "" : "not "),"ok 21\n";
-$c = "\cU";
-print +((ord($c) == 21) ? "" : "not "),"ok 22\n";
-$c = "\cV";
-print +((ord($c) == 22) ? "" : "not "),"ok 23\n";
-$c = "\cW";
-print +((ord($c) == 23) ? "" : "not "),"ok 24\n";
-$c = "\cX";
-print +((ord($c) == 24) ? "" : "not "),"ok 25\n";
-$c = "\cY";
-print +((ord($c) == 25) ? "" : "not "),"ok 26\n";
-$c = "\cZ";
-print +((ord($c) == 26) ? "" : "not "),"ok 27\n";
-$c = "\c[";
-print +((ord($c) == 27) ? "" : "not "),"ok 28\n";
-$c = "\c\\";
-print +((ord($c) == 28) ? "" : "not "),"ok 29\n";
-$c = "\c]";
-print +((ord($c) == 29) ? "" : "not "),"ok 30\n";
-$c = "\c^";
-print +((ord($c) == 30) ? "" : "not "),"ok 31\n";
-$c = "\c_";
-print +((ord($c) == 31) ? "" : "not "),"ok 32\n";
-$c = "\c?";
-print +((ord($c) == 127) ? "" : "not "),"ok 33\n";
+my $c;
+ok(($c="\c@", ord($c) == 0), 'control-@ == 0');
+ok(($c="\cA", ord($c) == 1), 'control-@ == 1');
+ok(($c="\cB", ord($c) == 2), 'control-@ == 2');
+ok(($c="\cC", ord($c) == 3), 'control-@ == 3');
+ok(($c="\cD", ord($c) == 4), 'control-@ == 4');
+ok(($c="\cE", ord($c) == 5), 'control-@ == 5');
+ok(($c="\cF", ord($c) == 6), 'control-@ == 6');
+ok(($c="\cG", ord($c) == 7), 'control-@ == 7');
+ok(($c="\cH", ord($c) == 8), 'control-@ == 8');
+ok(($c="\cI", ord($c) == 9), 'control-@ == 9');
+ok(($c="\cJ", ord($c) == 10), 'control-@ == 10');
+ok(($c="\cK", ord($c) == 11), 'control-@ == 11');
+ok(($c="\cL", ord($c) == 12), 'control-@ == 12');
+ok(($c="\cM", ord($c) == 13), 'control-@ == 13');
+ok(($c="\cN", ord($c) == 14), 'control-@ == 14');
+ok(($c="\cO", ord($c) == 15), 'control-@ == 15');
+ok(($c="\cP", ord($c) == 16), 'control-@ == 16');
+ok(($c="\cQ", ord($c) == 17), 'control-@ == 17');
+ok(($c="\cR", ord($c) == 18), 'control-@ == 18');
+ok(($c="\cS", ord($c) == 19), 'control-@ == 19');
+ok(($c="\cT", ord($c) == 20), 'control-@ == 20');
+ok(($c="\cU", ord($c) == 21), 'control-@ == 21');
+ok(($c="\cV", ord($c) == 22), 'control-@ == 22');
+ok(($c="\cW", ord($c) == 23), 'control-@ == 23');
+ok(($c="\cX", ord($c) == 24), 'control-@ == 24');
+ok(($c="\cY", ord($c) == 25), 'control-@ == 25');
+ok(($c="\cZ", ord($c) == 26), 'control-@ == 26');
+ok(($c="\c[", ord($c) == 27), 'control-[ == 27');
+ok(($c="\c\\", ord($c) == 28), 'control-\\ == 28');
+ok(($c="\c]", ord($c) == 29), 'control-] == 29');
+ok(($c="\c^", ord($c) == 30), 'control-^ == 30');
+ok(($c="\c_", ord($c) == 31), 'control-_ == 31');
+ok(($c="\c?", ord($c) == 127), 'control-? == 127');
--- ../op/closure.t Sat Jun 16 16:49:30 2001
+++ closure.t Thu Aug 30 10:37:58 2001
@@ -263,8 +263,11 @@
my \$test = $test;
sub test (&) {
my \$result = &{\$_[0]};
- print "not " unless \$result;
- print "ok \$test\\n";
+ my \$out = "";
+ \$out = "not " unless \$result;
+ \$out .= "ok \$test\\n";
+ print \$out;
+
\$test++;
}
}
@@ -504,6 +507,5 @@
} # End of foreach $within
} # End of foreach $where_declared
} # End of foreach $inner_type
-
}
--- ../old_op/concat.t Sun Aug 12 00:34:56 2001
+++ concat.t Thu Aug 30 11:02:44 2001
@@ -5,49 +5,38 @@
@INC = '../lib';
}
-print "1..11\n";
+use Test::More tests=>12;
($a, $b, $c) = qw(foo bar);
-print "not " unless "$a" eq "foo";
-print "ok 1\n";
+is("$a", "foo", "verifying assign");
-print "not " unless "$a$b" eq "foobar";
-print "ok 2\n";
+is("$a$b", "foobar", "basic concatenation");
-print "not " unless "$c$a$c" eq "foo";
-print "ok 3\n";
+is("$c$a$c", "foo", "concatenate undef, fore and aft");
# Okay, so that wasn't very challenging. Let's go Unicode.
-my $test = 4;
-
{
# bug id 20000819.004
$_ = $dx = "\x{10f2}";
s/($dx)/$dx$1/;
{
- print "not " unless $_ eq "$dx$dx";
- print "ok $test\n";
- $test++;
+ is($_, "$dx$dx","bug id 20000819.004, back");
}
$_ = $dx = "\x{10f2}";
s/($dx)/$1$dx/;
{
- print "not " unless $_ eq "$dx$dx";
- print "ok $test\n";
- $test++;
+ is($_, "$dx$dx","bug id 20000819.004, front");
}
$dx = "\x{10f2}";
$_ = "\x{10f2}\x{10f2}";
s/($dx)($dx)/$1$2/;
{
- print "not " unless $_ eq "$dx$dx";
- print "ok $test\n";
- $test++;
+ is($_, "$dx$dx","bug id 20000819.004, front and back");
}
}
@@ -57,9 +46,9 @@
my $a;
$a .= "\x{1ff}";
- print "not " unless $a eq "\x{1ff}";
- print "ok $test\n";
- $test++;
+ is($a, "\x{1ff}", "bug id 20000901.092, undef left");
+ $a .= undef;
+ is($a, "\x{1ff}", "bug id 20000901.092, undef right");
}
{
@@ -69,29 +58,17 @@
# Without the fix this 5.7.0 would croak:
# Modification of a read-only value attempted at ...
- "$2\x{1234}";
-
- print "ok $test\n";
- $test++;
+ ok("$2\x{1234}", "bug id 20001020.006, left");
# For symmetry with the above.
- "\x{1234}$2";
-
- print "ok $test\n";
- $test++;
+ ok("\x{1234}$2", "bug id 20001020.006, right");
*pi = \undef;
# This bug existed earlier than the $2 bug, but is fixed with the same
# patch. Without the fix this 5.7.0 would also croak:
# Modification of a read-only value attempted at ...
- "$pi\x{1234}";
-
- print "ok $test\n";
- $test++;
+ ok("$pi\x{1234}", "bug id 20001020.006, constant left");
# For symmetry with the above.
- "\x{1234}$pi";
-
- print "ok $test\n";
- $test++;
+ ok("\x{1234}$pi", "bug id 20001020.006, constant right");
}
--- ../old_op/defins.t Mon Jun 11 09:33:14 2001
+++ defins.t Wed Aug 29 16:53:12 2001
@@ -8,14 +8,14 @@
chdir 't' if -d 't';
@INC = '../lib';
$SIG{__WARN__} = sub { $warns++; warn $_[0] };
- print "1..14\n";
}
+use Test::More tests=>14;
+
$wanted_filename = $^O eq 'VMS' ? '0.' : '0';
$saved_filename = $^O eq 'MacOS' ? ':0' : './0';
-
-print "not " if $warns;
-print "ok 1\n";
+
+ok(!$warns, "no warnings yet");
open(FILE,">$saved_filename");
print FILE "1\n";
@@ -29,8 +29,7 @@
{
$seen++ if $name eq '0';
}
-print "not " unless $seen;
-print "ok 2\n";
+ok($seen, "prefix while, reading file");
seek(FILE,0,0);
$seen = 0;
@@ -40,9 +39,7 @@
$seen++ if $line eq '0';
} while ($line = <FILE>);
-print "not " unless $seen;
-print "ok 3\n";
-
+ok($seen,"suffix while, reading file");
seek(FILE,0,0);
$seen = 0;
@@ -50,8 +47,7 @@
{
$seen++ if $name eq '0';
}
-print "not " unless $seen;
-print "ok 4\n";
+ok($seen, "conditional expression, reading file");
seek(FILE,0,0);
$seen = 0;
@@ -60,8 +56,7 @@
{
$seen++ if $where{$seen} eq '0';
}
-print "not " unless $seen;
-print "ok 5\n";
+ok($seen,"hash");
close FILE;
opendir(DIR,($^O eq 'MacOS' ? ':' : '.'));
@@ -70,8 +65,7 @@
{
$seen++ if $name eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 6\n";
+ok($seen, "prefix while, readdir");
rewinddir(DIR);
$seen = 0;
@@ -80,8 +74,7 @@
{
$seen++ if $name eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 7\n";
+ok($seen, "conditional, readdir");
rewinddir(DIR);
$seen = 0;
@@ -89,16 +82,14 @@
{
$seen++ if $where{$seen} eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 8\n";
+ok($seen, "hash, readdir");
$seen = 0;
while (my $name = glob('*'))
{
$seen++ if $name eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 9\n";
+ok($seen, "glob");
$seen = 0;
$dummy = '';
@@ -106,16 +97,14 @@
{
$seen++ if $name eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 10\n";
+ok($seen, "glob, conditional");
$seen = 0;
while ($where{$seen} = glob('*'))
{
$seen++ if $where{$seen} eq $wanted_filename;
}
-print "not " unless $seen;
-print "ok 11\n";
+ok($seen, "glob, hash");
unlink($saved_filename);
@@ -126,8 +115,7 @@
{
$seen++ if $name eq '0';
}
-print "not " unless $seen;
-print "ok 12\n";
+ok($seen, "each");
$seen = 0;
$dummy = '';
@@ -135,14 +123,11 @@
{
$seen++ if $name eq '0';
}
-print "not " unless $seen;
-print "ok 13\n";
+ok($seen, "each, conditional");
$seen = 0;
while ($where{$seen} = each %hash)
{
$seen++ if $where{$seen} eq '0';
}
-print "not " unless $seen;
-print "ok 14\n";
-
+ok($seen, "each, hash");
--- ../old_op/delete.t Mon Jul 31 22:32:13 2000
+++ delete.t Thu Aug 30 12:53:10 2001
@@ -1,6 +1,6 @@
#!./perl
-print "1..36\n";
+use Test::More tests=>36;
# delete() on hash elements
@@ -12,25 +12,25 @@
$foo = delete $foo{2};
-if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
-unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
-if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
-if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
-if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";}
-if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";}
+is($foo, 'b', "value correct from hash delete()");
+ok(!exists $foo{2}, "\$foo{2} is really gone");
+is($foo{1}, 'a', "\$foo{1} still OK");
+is($foo{3}, 'c', "\$foo{3} still OK");
+is($foo{4}, 'd', "\$foo{4} still OK");
+is($foo{5}, 'e', "\$foo{5} still OK");
@foo = delete @foo{4, 5};
-if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";}
-if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";}
-if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";}
-unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
-unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
-if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
-if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
+is(scalar(@foo), 2, "slice delete");
+is($foo[0], 'd', "value 1 ok from hash slice delete");
+is($foo[1], 'e', "value 2 ok from hash slice delete");
+ok(!exists $foo{4}, "\$foo{4} really gone");
+ok(!exists $foo{5}, "\$foo{5} really gone");
+is($foo{1}, 'a', "\$foo{1} still OK");
+is($foo{3}, 'c', "\$foo{3} still OK");
$foo = join('',values(%foo));
-if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
+ok($foo eq 'ac' || $foo eq 'ca', "values() check");
foreach $key (keys %foo) {
delete $foo{$key};
@@ -40,7 +40,7 @@
$foo{'bar'} = 'y';
$foo = join('',values(%foo));
-print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
+ok($foo eq 'xy' || $foo eq 'yx', "out with the old hash, in with the new");
$refhash{"top"}->{"foo"} = "FOO";
$refhash{"top"}->{"bar"} = "BAR";
@@ -48,7 +48,7 @@
delete $refhash{"top"}->{"bar"};
@list = keys %{$refhash{"top"}};
-print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n";
+is("@list", "foo", "delete from \$refhash");
{
my %a = ('bar', 33);
@@ -56,8 +56,7 @@
my $b = \$a{bar};
my $c = \delete $a{bar};
- print "not " unless $a == $b && $b == $c;
- print "ok 17\n";
+ ok($a == $b && $b == $c, "complex hash delete, refs and my()");
}
# delete() on array elements
@@ -71,46 +70,46 @@
$foo = delete $foo[2];
-if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";}
-unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";}
-if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";}
-if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";}
-if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";}
-if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";}
+is($foo, 'b', "array delete() value");
+ok(!exists $foo[2], "\$foo[2] actually gone");
+is($foo[1], 'a', "\$foo[1] still ok");
+is($foo[3], 'c', "\$foo[3] still ok");
+is($foo[4], 'd', "\$foo[4] still ok");
+is($foo[5], 'e', "\$foo[5] still ok");
@bar = delete @foo[4,5];
-if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";}
-if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";}
-if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";}
-unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";}
-unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";}
-if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";}
-if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";}
+is(scalar(@bar), 2, "array slice delete");
+is($bar[0], 'd', "first value OK");
+is($bar[1], 'e', "second value OK");
+ok(!exists $foo[4], "\$foo[4] really gone");
+ok(!exists $foo[5], "\$foo[5] really gone");
+is($foo[1], 'a', "\$foo[1] still ok");
+is($foo[3], 'c', "\$foo[3] still ok");
$foo = join('',@foo);
-if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";}
+is($foo, 'ac', "join() on array");
-if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";}
+is(scalar(@foo), 4, "still has 4 elements");
foreach $key (0 .. $#foo) {
delete $foo[$key];
}
-if (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";}
+is(scalar(@foo), 0, "loop deleted everything");
$foo[0] = 'x';
$foo[1] = 'y';
$foo = "@foo";
-print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n";
+is($foo, 'x y', "out with the old array, in with the new");
$refary[0]->[0] = "FOO";
$refary[0]->[3] = "BAR";
delete $refary[0]->[3];
-print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n";
+is(scalar(@{$refary[0]}), 1, "delete on array of refs");
{
my @a = 33;
@@ -118,6 +117,5 @@
my $b = \$a[0];
my $c = \delete $a[bar];
- print "not " unless $a == $b && $b == $c;
- print "ok 36\n";
+ ok($a == $b && $b == $c, "complex hash delete, refs and my()");
}
--- ../old_op/die.t Mon Jul 31 22:32:13 2000
+++ die.t Wed Aug 29 17:19:41 2001
@@ -9,14 +9,12 @@
die $err;
};
-print "not " unless $@ eq $err;
-print "ok 2\n";
+print ($@ eq $err ? "ok 2\n" : "not ok 2\n");
$x = [3];
eval { die $x; };
-print "not " unless $x->[0] == 4;
-print "ok 4\n";
+print ($x->[0] == 4 ? "ok 4\n" : "not ok 4\n");
eval {
eval {
@@ -32,8 +30,7 @@
die if $@;
};
-print "not " unless ref($@) eq "Out";
-print "ok 10\n";
+print (ref($@) eq "Out" ? "ok 10\n" : "not ok 10\n");
package Error;
