1*0Sstevel@tonic-gate#!./perl -w 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate$|=1; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateBEGIN { 6*0Sstevel@tonic-gate chdir 't' if -d 't'; 7*0Sstevel@tonic-gate @INC = '../lib'; 8*0Sstevel@tonic-gate require Config; import Config; 9*0Sstevel@tonic-gate if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { 10*0Sstevel@tonic-gate print "1..0\n"; 11*0Sstevel@tonic-gate exit 0; 12*0Sstevel@tonic-gate } 13*0Sstevel@tonic-gate} 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gateuse Opcode qw( 16*0Sstevel@tonic-gate opcodes opdesc opmask verify_opset 17*0Sstevel@tonic-gate opset opset_to_ops opset_to_hex invert_opset 18*0Sstevel@tonic-gate opmask_add full_opset empty_opset define_optag 19*0Sstevel@tonic-gate); 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gateuse strict; 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gatemy $t = 1; 24*0Sstevel@tonic-gatemy $last_test; # initalised at end 25*0Sstevel@tonic-gateprint "1..$last_test\n"; 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gatemy($s1, $s2, $s3); 28*0Sstevel@tonic-gatemy(@o1, @o2, @o3); 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate# --- opset_to_ops and opset 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gatemy @empty_l = opset_to_ops(empty_opset); 33*0Sstevel@tonic-gateprint @empty_l == 0 ? "ok $t\n" : "not ok $t\n"; $t++; 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gatemy @full_l1 = opset_to_ops(full_opset); 36*0Sstevel@tonic-gateprint @full_l1 == opcodes() ? "ok $t\n" : "not ok $t\n"; $t++; 37*0Sstevel@tonic-gatemy @full_l2 = @full_l1; # = opcodes(); # XXX to be fixed 38*0Sstevel@tonic-gateprint "@full_l1" eq "@full_l2" ? "ok $t\n" : "not ok $t\n"; $t++; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate@empty_l = opset_to_ops(opset(':none')); 41*0Sstevel@tonic-gateprint @empty_l == 0 ? "ok $t\n" : "not ok $t\n"; $t++; 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gatemy @full_l3 = opset_to_ops(opset(':all')); 44*0Sstevel@tonic-gateprint @full_l1 == @full_l3 ? "ok $t\n" : "not ok $t\n"; $t++; 45*0Sstevel@tonic-gateprint "@full_l1" eq "@full_l3" ? "ok $t\n" : "not ok $t\n"; $t++; 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gatedie $t unless $t == 7; 48*0Sstevel@tonic-gate$s1 = opset( 'padsv'); 49*0Sstevel@tonic-gate$s2 = opset($s1, 'padav'); 50*0Sstevel@tonic-gate$s3 = opset($s2, '!padav'); 51*0Sstevel@tonic-gateprint $s1 eq $s2 ? "not ok $t\n" : "ok $t\n"; ++$t; 52*0Sstevel@tonic-gateprint $s1 eq $s3 ? "ok $t\n" : "not ok $t\n"; ++$t; 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate# --- define_optag 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateprint eval { opset(':_tst_') } ? "not ok $t\n" : "ok $t\n"; ++$t; 57*0Sstevel@tonic-gatedefine_optag(":_tst_", opset(qw(padsv padav padhv))); 58*0Sstevel@tonic-gateprint eval { opset(':_tst_') } ? "ok $t\n" : "not ok $t\n"; ++$t; 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gate# --- opdesc and opcodes 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gatedie $t unless $t == 11; 63*0Sstevel@tonic-gateprint opdesc("gv") eq "glob value" ? "ok $t\n" : "not ok $t\n"; $t++; 64*0Sstevel@tonic-gatemy @desc = opdesc(':_tst_','stub'); 65*0Sstevel@tonic-gateprint "@desc" eq "private variable private array private hash stub" 66*0Sstevel@tonic-gate ? "ok $t\n" : "not ok $t\n#@desc\n"; $t++; 67*0Sstevel@tonic-gateprint opcodes() ? "ok $t\n" : "not ok $t\n"; $t++; 68*0Sstevel@tonic-gateprint "ok $t\n"; ++$t; 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate# --- invert_opset 71*0Sstevel@tonic-gate 72*0Sstevel@tonic-gate$s1 = opset(qw(fileno padsv padav)); 73*0Sstevel@tonic-gate@o2 = opset_to_ops(invert_opset($s1)); 74*0Sstevel@tonic-gateprint @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++; 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate# --- opmask 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gatedie $t unless $t == 16; 79*0Sstevel@tonic-gateprint opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++; # work 80*0Sstevel@tonic-gateprint length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++; 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gate# --- verify_opset 83*0Sstevel@tonic-gate 84*0Sstevel@tonic-gateprint verify_opset($s1) && !verify_opset(42) ? "ok $t\n":"not ok $t\n"; $t++; 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gate# --- opmask_add 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gateopmask_add(opset(qw(fileno))); # add to global op_mask 89*0Sstevel@tonic-gateprint eval 'fileno STDOUT' ? "not ok $t\n" : "ok $t\n"; $t++; # fail 90*0Sstevel@tonic-gateprint $@ =~ /'fileno' trapped/ ? "ok $t\n" : "not ok $t\n# $@\n"; $t++; 91*0Sstevel@tonic-gate 92*0Sstevel@tonic-gate# --- check use of bit vector ops on opsets 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gate$s1 = opset('padsv'); 95*0Sstevel@tonic-gate$s2 = opset('padav'); 96*0Sstevel@tonic-gate$s3 = opset('padsv', 'padav', 'padhv'); 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gate# Non-negated 99*0Sstevel@tonic-gateprint (($s1 | $s2) eq opset($s1,$s2) ? "ok $t\n":"not ok $t\n"); $t++; 100*0Sstevel@tonic-gateprint (($s2 & $s3) eq opset($s2) ? "ok $t\n":"not ok $t\n"); $t++; 101*0Sstevel@tonic-gateprint (($s2 ^ $s3) eq opset('padsv','padhv') ? "ok $t\n":"not ok $t\n"); $t++; 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate# Negated, e.g., with possible extra bits in last byte beyond last op bit. 104*0Sstevel@tonic-gate# The extra bits mean we can't just say ~mask eq invert_opset(mask). 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gate@o1 = opset_to_ops( ~ $s3); 107*0Sstevel@tonic-gate@o2 = opset_to_ops(invert_opset $s3); 108*0Sstevel@tonic-gateprint "@o1" eq "@o2" ? "ok $t\n":"not ok $t\n"; $t++; 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gate# --- finally, check some opname assertions 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gateforeach(@full_l1) { die "bad opname: $_" if /\W/ or /^\d/ } 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gateprint "ok $last_test\n"; 115*0Sstevel@tonic-gateBEGIN { $last_test = 25 } 116