#!./perl
-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
my %seen;
package main;
-print "1..66\n";
-my $test = 1;
+plan(tests => 66);
{my @ary;
{ my $ob = tie @ary,'Implement',3,2,1;
- print "not " unless $ob;
- print "ok ", $test++,"\n";
- print "not " unless tied(@ary) == $ob;
- print "ok ", $test++,"\n";
+ ok($ob);
+ is(tied(@ary), $ob);
}
-
-print "not " unless @ary == 3;
-print "ok ", $test++,"\n";
-
-print "not " unless $#ary == 2;
-print "ok ", $test++,"\n";
-
-print "not " unless join(':',@ary) eq '3:2:1';
-print "ok ", $test++,"\n";
-
-print "not " unless $seen{'FETCH'} >= 3;
-print "ok ", $test++,"\n";
+is(@ary, 3);
+is($#ary, 2);
+is(join(':',@ary), '3:2:1');
+cmp_ok($seen{'FETCH'}, '>=', 3);
@ary = (1,2,3);
-print "not " unless $seen{'STORE'} >= 3;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '1:2:3';
-print "ok ", $test++,"\n";
+cmp_ok($seen{'STORE'}, '>=', 3);
+is(join(':',@ary), '1:2:3');
{my @thing = @ary;
-print "not " unless join(':',@thing) eq '1:2:3';
-print "ok ", $test++,"\n";
+is(join(':',@thing), '1:2:3');
tie @thing,'Implement';
@thing = @ary;
-print "not " unless join(':',@thing) eq '1:2:3';
-print "ok ", $test++,"\n";
+is(join(':',@thing), '1:2:3');
}
-print "not " unless pop(@ary) == 3;
-print "ok ", $test++,"\n";
-print "not " unless $seen{'POP'} == 1;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '1:2';
-print "ok ", $test++,"\n";
+is(pop(@ary), 3);
+is($seen{'POP'}, 1);
+is(join(':',@ary), '1:2');
push(@ary,4);
-print "not " unless $seen{'PUSH'} == 1;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '1:2:4';
-print "ok ", $test++,"\n";
+is($seen{'PUSH'}, 1);
+is(join(':',@ary), '1:2:4');
my @x = splice(@ary,1,1,7);
+is($seen{'SPLICE'}, 1);
+is(@x, 1);
+is($x[0], 2);
+is(join(':',@ary), '1:7:4');
-print "not " unless $seen{'SPLICE'} == 1;
-print "ok ", $test++,"\n";
-
-print "not " unless @x == 1;
-print "ok ", $test++,"\n";
-print "not " unless $x[0] == 2;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '1:7:4';
-print "ok ", $test++,"\n";
-
-print "not " unless shift(@ary) == 1;
-print "ok ", $test++,"\n";
-print "not " unless $seen{'SHIFT'} == 1;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '7:4';
-print "ok ", $test++,"\n";
+is(shift(@ary), 1);
+is($seen{'SHIFT'}, 1);
+is(join(':',@ary), '7:4');
my $n = unshift(@ary,5,6);
-print "not " unless $seen{'UNSHIFT'} == 1;
-print "ok ", $test++,"\n";
-print "not " unless $n == 4;
-print "ok ", $test++,"\n";
-print "not " unless join(':',@ary) eq '5:6:7:4';
-print "ok ", $test++,"\n";
+is($seen{'UNSHIFT'}, 1);
+is($n, 4);
+is(join(':',@ary), '5:6:7:4');
@ary = split(/:/,'1:2:3');
-print "not " unless join(':',@ary) eq '1:2:3';
-print "ok ", $test++,"\n";
+is(join(':',@ary), '1:2:3');
my $t = 0;
foreach $n (@ary)
{
- print "not " unless $n == ++$t;
- print "ok ", $test++,"\n";
+ is($n, ++$t);
}
# (30-33) 20020303 mjd-perl-patch+@plover.com
@ary = ();
$seen{POP} = 0;
pop @ary; # this didn't used to call POP at all
-print "not " unless $seen{POP} == 1;
-print "ok ", $test++,"\n";
+is($seen{POP}, 1);
$seen{SHIFT} = 0;
shift @ary; # this didn't used to call SHIFT at all
-print "not " unless $seen{SHIFT} == 1;
-print "ok ", $test++,"\n";
+is($seen{SHIFT}, 1);
$seen{PUSH} = 0;
push @ary; # this didn't used to call PUSH at all
-print "not " unless $seen{PUSH} == 1;
-print "ok ", $test++,"\n";
+is($seen{PUSH}, 1);
$seen{UNSHIFT} = 0;
unshift @ary; # this didn't used to call UNSHIFT at all
-print "not " unless $seen{UNSHIFT} == 1;
-print "ok ", $test++,"\n";
+is($seen{UNSHIFT}, 1);
@ary = qw(3 2 1);
-print "not " unless join(':',@ary) eq '3:2:1';
-print "ok ", $test++,"\n";
+is(join(':',@ary), '3:2:1');
$#ary = 1;
-print "not " unless $seen{'STORESIZE'} == 1;
-print "ok ", $test++," -- seen STORESIZE\n";
-print "not " unless join(':',@ary) eq '3:2';
-print "ok ", $test++,"\n";
+is($seen{'STORESIZE'}, 1, 'seen STORESIZE');
+is(join(':',@ary), '3:2');
sub arysize :lvalue { $#ary }
arysize()--;
-print "not " unless $seen{'STORESIZE'} == 2;
-print "ok ", $test++," -- seen STORESIZE\n";
-print "not " unless join(':',@ary) eq '3';
-print "ok ", $test++,"\n";
+is($seen{'STORESIZE'}, 2, 'seen STORESIZE');
+is(join(':',@ary), '3');
untie @ary;
tie @a, 'X';
eval { splice(@a) };
# If we survived this far.
- print "ok ", $test++, "\n";
+ pass();
}
-
{ # 20020220 mjd-perl-patch+@plover.com
my @n;
tie @n => 'NegIndex', ('A' .. 'E');
# FETCH
- print "not " unless $n[0] eq 'C';
- print "ok ", $test++,"\n";
- print "not " unless $n[1] eq 'D';
- print "ok ", $test++,"\n";
- print "not " unless $n[2] eq 'E';
- print "ok ", $test++,"\n";
- print "not " unless $n[-1] eq 'B';
- print "ok ", $test++,"\n";
- print "not " unless $n[-2] eq 'A';
- print "ok ", $test++,"\n";
+ is($n[0], 'C');
+ is($n[1], 'D');
+ is($n[2], 'E');
+ is($n[-1], 'B');
+ is($n[-2], 'A');
# STORE
$n[-2] = 'a';
- print "not " unless $n[-2] eq 'a';
- print "ok ", $test++,"\n";
+ is($n[-2], 'a');
$n[-1] = 'b';
- print "not " unless $n[-1] eq 'b';
- print "ok ", $test++,"\n";
+ is($n[-1], 'b');
$n[0] = 'c';
- print "not " unless $n[0] eq 'c';
- print "ok ", $test++,"\n";
+ is($n[0], 'c');
$n[1] = 'd';
- print "not " unless $n[1] eq 'd';
- print "ok ", $test++,"\n";
+ is($n[1], 'd');
$n[2] = 'e';
- print "not " unless $n[2] eq 'e';
- print "ok ", $test++,"\n";
+ is($n[2], 'e');
# DELETE and EXISTS
for (-2 .. 2) {
- print exists($n[$_]) ? "ok $test\n" : "not ok $test\n";
- $test++;
+ ok($n[$_]);
delete $n[$_];
- print defined($n[$_]) ? "not ok $test\n" : "ok $test\n";
- $test++;
- print exists($n[$_]) ? "not ok $test\n" : "ok $test\n";
- $test++;
+ is(defined($n[$_]), '');
+ is(exists($n[$_]), '');
}
}
-
-
{
tie my @dummy, "NegFetchsize";
eval { "@dummy"; };
- print "# $@" if $@;
- print "not " unless $@ =~ /^FETCHSIZE returned a negative value/;
- print "ok ", $test++, " - croak on negative FETCHSIZE\n";
+ like($@, qr/^FETCHSIZE returned a negative value/,
+ " - croak on negative FETCHSIZE");
}
-print "not " unless $seen{'DESTROY'} == 3;
-print "ok ", $test++,"\n";
-
+is($seen{'DESTROY'}, 3);