summaryrefslogtreecommitdiff
path: root/ext/Opcode
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2010-11-09 13:09:29 +0000
committerNicholas Clark <nick@ccl4.org>2010-11-09 13:09:29 +0000
commitddd7db170665460ccedfef1ffcda100256dabfd6 (patch)
treeef9d0ad9a4ed90d1ebe94ae813f4deedbe49bd24 /ext/Opcode
parente89bfaa62e9e0ba9df6482deee1c3a10abd743fb (diff)
downloadperl-ddd7db170665460ccedfef1ffcda100256dabfd6.tar.gz
Convert ext/Opcode/t/Opcode.t to Test::More.
The tests (including the still-TODO) mostly date from 1996.
Diffstat (limited to 'ext/Opcode')
-rw-r--r--ext/Opcode/t/Opcode.t78
1 files changed, 39 insertions, 39 deletions
diff --git a/ext/Opcode/t/Opcode.t b/ext/Opcode/t/Opcode.t
index 524fb8f6c7..39d01cc636 100644
--- a/ext/Opcode/t/Opcode.t
+++ b/ext/Opcode/t/Opcode.t
@@ -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();