Convert tiearray.t to test.pl.
Nicholas Clark [Sun, 6 Jun 2010 09:46:16 +0000 (11:46 +0200)]
t/op/tiearray.t

index ca8a3c3..3040ae4 100644 (file)
@@ -1,9 +1,9 @@
 #!./perl
 
-
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 my %seen;
@@ -147,135 +147,92 @@ sub FETCHSIZE { -1 }
 
 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;   
 
@@ -296,65 +253,46 @@ 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);