diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-11-09 13:09:29 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-11-09 13:09:29 +0000 |
commit | ddd7db170665460ccedfef1ffcda100256dabfd6 (patch) | |
tree | ef9d0ad9a4ed90d1ebe94ae813f4deedbe49bd24 /ext/Opcode | |
parent | e89bfaa62e9e0ba9df6482deee1c3a10abd743fb (diff) | |
download | perl-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.t | 78 |
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(); |