This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert ext/Opcode/t/Opcode.t to Test::More.
authorNicholas Clark <nick@ccl4.org>
Tue, 9 Nov 2010 13:09:29 +0000 (13:09 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 9 Nov 2010 13:09:29 +0000 (13:09 +0000)
The tests (including the still-TODO) mostly date from 1996.

ext/Opcode/t/Opcode.t

index 524fb8f..39d01cc 100644 (file)
@@ -10,17 +10,16 @@ BEGIN {
     }
 }
 
-use Opcode qw(
+use strict;
+use Test::More;
+
+BEGIN {
+    use_ok('Opcode', qw(
        opcodes opdesc opmask verify_opset
        opset opset_to_ops opset_to_hex invert_opset
        opmask_add full_opset empty_opset define_optag
-);
-
-use strict;
-
-my $t = 1;
-my $last_test; # initalised at end
-print "1..$last_test\n";
+                      ));
+}
 
 my($s1, $s2, $s3);
 my(@o1, @o2, @o3);
@@ -28,64 +27,66 @@ my(@o1, @o2, @o3);
 # --- opset_to_ops and opset
 
 my @empty_l = opset_to_ops(empty_opset);
-print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+is_deeply (\@empty_l, []);
 
 my @full_l1  = opset_to_ops(full_opset);
-print @full_l1 == opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
-my @full_l2 = @full_l1;        # = opcodes();  # XXX to be fixed
-print "@full_l1" eq "@full_l2" ? "ok $t\n" : "not ok $t\n"; $t++;
+is (scalar @full_l1, scalar opcodes());
+
+{
+    local $::TODO = "opcodes in list context not yet implemented";
+    my @full_l2 = eval {opcodes()};
+    is($@, '');
+    is_deeply(\@full_l1, \@full_l2);
+}
 
 @empty_l = opset_to_ops(opset(':none'));
-print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+is_deeply(\@empty_l, []);
 
 my @full_l3 = opset_to_ops(opset(':all'));
-print  @full_l1  ==  @full_l3  ? "ok $t\n" : "not ok $t\n"; $t++;
-print "@full_l1" eq "@full_l3" ? "ok $t\n" : "not ok $t\n"; $t++;
+is_deeply(\@full_l1, \@full_l3);
 
-die $t unless $t == 7;
 $s1 = opset(      'padsv');
 $s2 = opset($s1,  'padav');
 $s3 = opset($s2, '!padav');
-print $s1 eq $s2 ? "not ok $t\n" : "ok $t\n"; ++$t;
-print $s1 eq $s3 ? "ok $t\n" : "not ok $t\n"; ++$t;
+isnt($s1, $s2);
+is($s1, $s3);
 
 # --- define_optag
 
-print eval { opset(':_tst_') } ? "not ok $t\n" : "ok $t\n"; ++$t;
+is(eval { opset(':_tst_') }, undef);
+like($@, qr/Unknown operator tag ":_tst_"/);
 define_optag(":_tst_", opset(qw(padsv padav padhv)));
-print eval { opset(':_tst_') } ? "ok $t\n" : "not ok $t\n"; ++$t;
+isnt(eval { opset(':_tst_') }, undef);
+is($@, '');
 
 # --- opdesc and opcodes
 
-die $t unless $t == 11;
-print opdesc("gv") eq "glob value" ? "ok $t\n" : "not ok $t\n"; $t++;
+is(opdesc("gv"), "glob value");
 my @desc = opdesc(':_tst_','stub');
-print "@desc" eq "private variable private array private hash stub"
-                                   ? "ok $t\n" : "not ok $t\n#@desc\n"; $t++;
-print opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
-print "ok $t\n"; ++$t;
+is_deeply(\@desc, ['private variable', 'private array', 'private hash', 'stub']);
+isnt(opcodes(), 0);
 
 # --- invert_opset
 
 $s1 = opset(qw(fileno padsv padav));
 @o2 = opset_to_ops(invert_opset($s1));
-print @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++;
+is(scalar @o2, opcodes-3);
 
 # --- opmask
 
-die $t unless $t == 16;
-print opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++;     # work
-print length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++;
+is(opmask(), empty_opset());
+is(length opmask(), int((opcodes()+7)/8));
 
 # --- verify_opset
 
-print verify_opset($s1) && !verify_opset(42) ? "ok $t\n":"not ok $t\n"; $t++;
+is(verify_opset($s1), 1);
+is(verify_opset(42), 0);
 
 # --- opmask_add
 
 opmask_add(opset(qw(fileno))); # add to global op_mask
-print eval 'fileno STDOUT' ? "not ok $t\n" : "ok $t\n";        $t++; # fail
-print $@ =~ /'fileno' trapped/ ? "ok $t\n" : "not ok $t\n# $@\n"; $t++;
+is(eval 'fileno STDOUT', undef);
+like($@, qr/'fileno' trapped/);
 
 # --- check use of bit vector ops on opsets
 
@@ -94,20 +95,19 @@ $s2 = opset('padav');
 $s3 = opset('padsv', 'padav', 'padhv');
 
 # Non-negated
-print (($s1 | $s2) eq opset($s1,$s2) ? "ok $t\n":"not ok $t\n"); $t++;
-print (($s2 & $s3) eq opset($s2)     ? "ok $t\n":"not ok $t\n"); $t++;
-print (($s2 ^ $s3) eq opset('padsv','padhv') ? "ok $t\n":"not ok $t\n"); $t++;
+is(($s1 | $s2), opset($s1,$s2));
+is(($s2 & $s3), opset($s2));
+is(($s2 ^ $s3), opset('padsv','padhv'));
 
 # Negated, e.g., with possible extra bits in last byte beyond last op bit.
 # The extra bits mean we can't just say ~mask eq invert_opset(mask).
 
 @o1 = opset_to_ops(           ~ $s3);
 @o2 = opset_to_ops(invert_opset $s3);
-print "@o1" eq "@o2" ? "ok $t\n":"not ok $t\n"; $t++;
+is_deeply(\@o1, \@o2);
 
 # --- finally, check some opname assertions
 
 foreach(@full_l1) { die "bad opname: $_" if /\W/ or /^\d/ }
 
-print "ok $last_test\n";
-BEGIN { $last_test = 25 }
+done_testing();