Mercurial > repo

view interps/clc-intercal/CLC-INTERCAL-Base-1.-94.-2/t/02bytecode-registers.t @ 9071:581584df6d82

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<fizzie> revert 942e964c81c1
author HackBot
date Sun, 25 Sep 2016 20:17:31 +0000
parents 859f9b4339e6
children
line wrap: on
line source

# test bytecode interpreter - registers

# Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

use Language::INTERCAL::GenericIO '1.-94.-2', qw($devnull);
use Language::INTERCAL::Interpreter '1.-94.-2';
use Language::INTERCAL::Rcfile '1.-94.-2';
use Language::INTERCAL::ByteCode '1.-94.-2', qw(:BC reg_code);
use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
use Language::INTERCAL::ReadNumbers '1.-94.-2', qw(roman_type);
use Language::INTERCAL::ArrayIO '1.-94.-2', qw(iotype);
use Language::INTERCAL::Charset '1.-94.-2', qw(charset);

my @all_tests = (
    ["Spot 1", { '.1' => 1234 }, { '.1' => 5678 }, undef, undef,
	[BC_STO, BC(5678), BC_SPO, BC(1)]],
    ["Spot 2", { }, { }, undef, SP_NOARRAY,
	[BC_STO, BC(666), BC_SUB, BC(6), BC_SPO, BC(1)]],
    ["Spot 3", { }, { }, undef, SP_NUMBER,
	[BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), BC_SPO, BC(1)]],
    ["Two Spot 1", { ':1' => 1234 }, { ':1' => 5678 }, undef, undef,
	[BC_STO, BC(5678), BC_TSP, BC(1)]],
    ["Two spot 2", { }, { }, undef, SP_NOARRAY,
	[BC_STO, BC(666), BC_SUB, BC(6), BC_TSP, BC(1)]],
    ["Two spot 3", { }, { }, undef, SP_NUMBER,
	[BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), BC_TSP, BC(1)]],
    ["Tail 1", { }, { }, undef, SP_NODIM,
	[BC_STO, BC(666), BC_SUB, BC(6), BC_TAI, BC(1)]],
    ["Tail 2", { }, { ',1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
	[BC_STO, BC(6), BC_TAI, BC(1)],
	[BC_STO, BC(8), BC_SUB, BC(1), BC_TAI, BC(1)],
	[BC_STO, BC(9), BC_SUB, BC(2), BC_TAI, BC(1)],
	[BC_STO, BC(12), BC_SUB, BC(3), BC_TAI, BC(1)],
	[BC_STO, BC(1), BC_SUB, BC(4), BC_TAI, BC(1)],
	[BC_STO, BC(69), BC_SUB, BC(5), BC_TAI, BC(1)],
	[BC_STO, BC(666), BC_SUB, BC(6), BC_TAI, BC(1)]],
    ["Tail 3", { }, { ',1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
	[BC_STO, BC_MUL, BC(2), BC(2), BC(3), BC_TAI, BC(1)],
	[BC_STO, BC(8), BC_SUB, BC(1), BC_SUB, BC(1), BC_TAI, BC(1)],
	[BC_STO, BC(9), BC_SUB, BC(2), BC_SUB, BC(1), BC_TAI, BC(1)],
	[BC_STO, BC(12), BC_SUB, BC(3), BC_SUB, BC(1), BC_TAI, BC(1)],
	[BC_STO, BC(1), BC_SUB, BC(1), BC_SUB, BC(2), BC_TAI, BC(1)],
	[BC_STO, BC(69), BC_SUB, BC(2), BC_SUB, BC(2), BC_TAI, BC(1)],
	[BC_STO, BC(666), BC_SUB, BC(3), BC_SUB, BC(2), BC_TAI, BC(1)]],
    ["Hybrid 1", { }, { }, undef, SP_NODIM,
	[BC_STO, BC(666), BC_SUB, BC(6), BC_HYB, BC(1)]],
    ["Hybrid 2", { }, { ';1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
	[BC_STO, BC(6), BC_HYB, BC(1)],
	[BC_STO, BC(8), BC_SUB, BC(1), BC_HYB, BC(1)],
	[BC_STO, BC(9), BC_SUB, BC(2), BC_HYB, BC(1)],
	[BC_STO, BC(12), BC_SUB, BC(3), BC_HYB, BC(1)],
	[BC_STO, BC(1), BC_SUB, BC(4), BC_HYB, BC(1)],
	[BC_STO, BC(69), BC_SUB, BC(5), BC_HYB, BC(1)],
	[BC_STO, BC(666), BC_SUB, BC(6), BC_HYB, BC(1)]],
    ["Hybrid 3", { }, { ';1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
	[BC_STO, BC_MUL, BC(2), BC(2), BC(3), BC_HYB, BC(1)],
	[BC_STO, BC(8), BC_SUB, BC(1), BC_SUB, BC(1), BC_HYB, BC(1)],
	[BC_STO, BC(9), BC_SUB, BC(2), BC_SUB, BC(1), BC_HYB, BC(1)],
	[BC_STO, BC(12), BC_SUB, BC(3), BC_SUB, BC(1), BC_HYB, BC(1)],
	[BC_STO, BC(1), BC_SUB, BC(1), BC_SUB, BC(2), BC_HYB, BC(1)],
	[BC_STO, BC(69), BC_SUB, BC(2), BC_SUB, BC(2), BC_HYB, BC(1)],
	[BC_STO, BC(666), BC_SUB, BC(3), BC_SUB, BC(2), BC_HYB, BC(1)]],
    ["%WT 0", { }, { '%WT' => 0 }, undef, undef,
	[BC_STO, BC(0), reg_code('%WT')]],
    ["%WT 1", { }, { '%WT' => 1 }, undef, undef,
	[BC_STO, BC(1), reg_code('%WT')]],
    ["%WT 2", { }, { }, undef, SP_NOASSIGN,
	[BC_STO, BC(2), reg_code('%WT')]],
    ["%RT CLC", { }, { '%RT' => roman_type('CLC') }, undef, undef,
	[BC_STO, _str('CLC'), reg_code('%RT')]],
    ["%RT UNDERLINE", { }, { '%RT' => roman_type('UNDERLINE') }, undef, undef,
	[BC_STO, _str('UNDERLINE'), reg_code('%RT')]],
    ["%RT ARCHAIC", { }, { '%RT' => roman_type('ARCHAIC') }, undef, undef,
	[BC_STO, _str('ARCHAIC'), reg_code('%RT')]],
    ["%RT MEDIAEVAL", { }, { '%RT' => roman_type('MEDIAEVAL') }, undef, undef,
	[BC_STO, _str('MEDIAEVAL'), reg_code('%RT')]],
    ["%RT MODERN", { }, { '%RT' => roman_type('MODERN') }, undef, undef,
	[BC_STO, _str('MODERN'), reg_code('%RT')]],
    ["%RT TRADITIONAL", { }, { '%RT' => roman_type('TRADITIONAL') }, undef, undef,
	[BC_STO, _str('TRADITIONAL'), reg_code('%RT')]],
    ["%RT WIMPMODE", { }, { '%RT' => roman_type('WIMPMODE') }, undef, undef,
	[BC_STO, _str('WIMPMODE'), reg_code('%RT')]],
    ["%RT INVALID", { }, { }, undef, SP_ROMAN,
	[BC_STO, _str('INVALID'), reg_code('%RT')]],
    ["%IO CLC", { }, { '%IO' => iotype('CLC') }, undef, undef,
	[BC_STO, _str('CLC'), reg_code('%IO')]],
    ["%IO C", { }, { '%IO' => iotype('C') }, undef, undef,
	[BC_STO, _str('C'), reg_code('%IO')]],
    ["%IO 1972", { }, { '%IO' => iotype('1972') }, undef, undef,
	[BC_STO, _str('1972'), reg_code('%IO')]],
    ["%IO INVALID", { }, { }, undef, SP_IOTYPE,
	[BC_STO, _str('INVALID'), reg_code('%IO')]],
    ["%BA 1", { }, { }, undef, SP_BASE,
	[BC_STO, BC(1), reg_code('%BA')]],
    ["%BA 2", { }, { '%BA' => 2 }, undef, undef,
	[BC_STO, BC(2), reg_code('%BA')]],
    ["%BA 3", { }, { '%BA' => 3 }, undef, undef,
	[BC_STO, BC(3), reg_code('%BA')]],
    ["%BA 4", { }, { '%BA' => 4 }, undef, undef,
	[BC_STO, BC(4), reg_code('%BA')]],
    ["%BA 5", { }, { '%BA' => 5 }, undef, undef,
	[BC_STO, BC(5), reg_code('%BA')]],
    ["%BA 6", { }, { '%BA' => 6 }, undef, undef,
	[BC_STO, BC(6), reg_code('%BA')]],
    ["%BA 7", { }, { '%BA' => 7 }, undef, undef,
	[BC_STO, BC(7), reg_code('%BA')]],
    ["%BA 8", { }, { }, undef, SP_BASE,
	[BC_STO, BC(8), reg_code('%BA')]],
    ["%CF 0", { }, { '%CF' => 0 }, undef, undef,
	[BC_STO, BC(0), reg_code('%CF')]],
    ["%CF 1", { }, { '%CF' => 1 }, undef, undef,
	[BC_STO, BC(1), reg_code('%CF')]],
    ["%CF 2", { }, { '%CF' => 2 }, undef, undef,
	[BC_STO, BC(2), reg_code('%CF')]],
    ["%CF 3", { }, { '%CF' => 3 }, undef, undef,
	[BC_STO, BC(3), reg_code('%CF')]],
    ["%CF 4", { }, { }, undef, SP_NOASSIGN,
	[BC_STO, BC(4), reg_code('%CF')]],
    ["%CR ASCII", { }, { '%CR' => charset('ASCII') }, undef, undef,
	[BC_STO, _str('ASCII'), reg_code('%CR')]],
    ["%CR Baudot", { }, { '%CR' => charset('Baudot') }, undef, undef,
	[BC_STO, _str('Baudot'), reg_code('%CR')]],
    ["%CR EBCDIC", { }, { '%CR' => charset('EBCDIC') }, undef, undef,
	[BC_STO, _str('EBCDIC'), reg_code('%CR')]],
    ["%CR Hollerith", { }, { '%CR' => charset('Hollerith') }, undef, undef,
	[BC_STO, _str('Hollerith'), reg_code('%CR')]],
    ["%CR INVALID", { }, { }, undef, SP_CHARSET,
	[BC_STO, _str('INVALID'), reg_code('%CR')]],
    ["%CW ASCII", { }, { '%CW' => charset('ASCII') }, undef, undef,
	[BC_STO, _str('ASCII'), reg_code('%CW')]],
    ["%CW Baudot", { }, { '%CW' => charset('Baudot') }, undef, undef,
	[BC_STO, _str('Baudot'), reg_code('%CW')]],
    ["%CW EBCDIC", { }, { '%CW' => charset('EBCDIC') }, undef, undef,
	[BC_STO, _str('EBCDIC'), reg_code('%CW')]],
    ["%CW Hollerith", { }, { '%CW' => charset('Hollerith') }, undef, undef,
	[BC_STO, _str('Hollerith'), reg_code('%CW')]],
    ["%CW INVALID", { }, { }, undef, SP_CHARSET,
	[BC_STO, _str('INVALID'), reg_code('%CW')]],
    ["%OS 1", { '%OS' => 1234 }, { '%OS' => 5678 }, undef, undef,
	[BC_STO, BC(5678), reg_code('%OS')]],
    ["%OS 2", { }, { }, undef, SP_NOARRAY,
	[BC_STO, BC(666), BC_SUB, BC(6), reg_code('%OS')]],
    ["%OS 3", { }, { }, undef, SP_NUMBER,
	[BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%OS')]],
    ["%TM 0", { }, { '%TM' => 0 }, undef, undef,
	[BC_STO, BC(0), reg_code('%TM')]],
    ["%TM 1", { }, { '%TM' => 1 }, undef, undef,
	[BC_STO, BC(1), reg_code('%TM')]],
    ["%TM 2", { }, { }, undef, SP_NOASSIGN,
	[BC_STO, BC(2), reg_code('%TM')]],
    ["%AR 1", { '%AR' => 1234 }, { '%AR' => 5678 }, undef, undef,
	[BC_STO, BC(5678), reg_code('%AR')]],
    ["%AR 2", { }, { }, undef, SP_NOARRAY,
	[BC_STO, BC(666), BC_SUB, BC(6), reg_code('%AR')]],
    ["%AR 3", { }, { }, undef, SP_NUMBER,
	[BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%AR')]],
    ["%AW 1", { '%AW' => 1234 }, { '%AW' => 5678 }, undef, undef,
	[BC_STO, BC(5678), reg_code('%AW')]],
    ["%AW 2", { }, { }, undef, SP_NOARRAY,
	[BC_STO, BC(666), BC_SUB, BC(6), reg_code('%AW')]],
    ["%AW 3", { }, { }, undef, SP_NUMBER,
	[BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%AW')]],
    ["%JS", { }, { '%JS' => 3 }, undef, SP_COMMENT, # *000 because it causes recompile
	[BC_STO, _str('JUNK'), reg_code('%JS')]],
    ["%SS", { }, { '%SS' => 4 }, undef, undef,
	[BC_STO, _str('SPACE'), reg_code('%SS')]],
    ["%PS", { }, { '%PS' => 1 }, undef, SP_COMMENT, # *000 because it causes recompile
	[BC_STO, _str('CONSTANT'), reg_code('%PS')]],
    ["%FS", { }, { '%FS' => 2 }, undef, undef,
	[BC_STO, _str('SYMBOL'), reg_code('%FS')]],
    ["%ES", { }, { '%ES' => 1 }, undef, undef,
	[BC_STO, _str('CONSTANT'), reg_code('%ES')]],
    ["%IS", { }, { '%IS' => 2 }, undef, SP_COMMENT, # *000 because it causes recompile
	[BC_STO, _str('SYMBOL'), reg_code('%IS')]],
    ["%DM 0", { }, { '%DM' => 0 }, undef, undef,
	[BC_STO, BC(0), reg_code('%DM')]],
    ["%DM 1", { }, { '%DM' => 1 }, undef, undef,
	[BC_STO, BC(1), reg_code('%DM')]],
    ["%DM 2", { }, { }, undef, SP_NOASSIGN,
	[BC_STO, BC(2), reg_code('%DM')]],
    ["^AV", { }, { '^AV' => 'The wee cute INTERCAL compiler produced ugly Perl' }, undef, undef,
	[BC_STO, _str('The wee cute INTERCAL compiler produced ugly Perl'), reg_code('^AV')]],
    ["^EV", { }, { '^EV' => 'The big ugly gcc produced even uglier objects' }, undef, undef,
	[BC_STO, _str('The big ugly gcc produced even uglier objects'), reg_code('^EV')]],
    ["Indirect 1", { }, { '.1' => 5678 }, undef, undef,
	[BC_STO, BC(5678), BC_TYP, BC_SPO, BC(2), BC(1)]],
    ["Indirect 2", { }, { '.1' => 5678 }, undef, undef,
	[BC_STO, BC(5678), BC_SPO, BC_NUM, BC_CHO, BC(1)]],
    ["Indirect 3", { }, { '.1' => 5678 }, undef, undef,
	[BC_STO, BC(5678), BC_TYP, BC_SPO, BC(3), BC_NUM, BC_CHO, BC(1)]],
    ["Overload Register 1", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 1234, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)]],
    ["Overload Register 2", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(2), BC_SPO, BC(2), BC_SPO, BC(3)]],
    ["Overload Register 3", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
	[BC_STO, BC(9), BC_SPO, BC(2)]],
    ["Overload Register 4", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
	[BC_STO, BC(9), BC_SPO, BC(1)]],
    ["Overload Register 5", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
	[BC_STO, BC_OVR, BC_SPO, BC(2), BC_SPO, BC(2), BC_SPO, BC(3)]],
    ["Overload Register 6", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
	[BC_STO, BC_ROR, BC_SPO, BC(2), BC_SPO, BC(3)]],
    ["Overload Register 7", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '@2' => 1234 }, undef, undef,
	[BC_STO, BC_OVR, BC_SPO, BC(1), BC_WHP, BC(2), BC_WHP, BC(3)]],
    ["Overload Many 1", { '.1' => 1234, '.2' => 5678 },
	    { '.1' => 1234, '.2' => 1234, '.3' => 6, ';1' => 1234, ',2' => 1234 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)]],
    ["Overload Many 2", { '.1' => 1234, '.2' => 5678 }, { '.1' => 5678, '.2' => 5678, '.3' => 6 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(2), BC(6), BC_SPO, BC(3)]],
    ["Overload Many 3", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 6 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
	[BC_STO, BC(9), BC_SPO, BC(2)]],
    ["Overload Many 4", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 6 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
	[BC_STO, BC(9), BC_SPO, BC(1)]],
    ["Overload Many 5", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 6 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
	[BC_STO, BC_OVM, BC_OWN, BC(1), BC_WHP, BC(0), BC(6), BC_SPO, BC(3)]],
    ["Overload Many 6", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 6 }, undef, undef,
	[BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
	[BC_STO, BC_ROM, BC(6), BC_SPO, BC(3)]],
    ["Owner 1", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
	[BC_ENS, BC_SPO, BC(6), BC_SPO, BC(2)],
	[BC_STO, BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_STO, BC_OWN, BC(1), BC_SPO, BC(6), BC_SPO, BC(4)]],
    ["Owner 2", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_ENS, BC_SPO, BC(6), BC_SPO, BC(4)],
	[BC_STO, BC_SPO, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)],
	[BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_SPO, BC(6)]],
    ["Owner 3", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(2)],
	[BC_STO, BC_OWN, BC(2), BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_STO, BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(4)]],
    ["Owner 4", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(4)],
	[BC_STO, BC_SPO, BC(1), BC_OWN, BC(2), BC_SPO, BC(5)],
	[BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_SPO, BC(5)]],
    ["Owner 5", { '.1' => 1234, '.2' => 5678 }, { '.3' => 5678, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
	[BC_ENS, BC_SPO, BC(1), BC_SPO, BC(2)],
	[BC_STO, BC_OWN, BC(1), BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_STO, BC_OWN, BC(1), BC_SPO, BC(1), BC_SPO, BC(4)]],
    ["Owner 6", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
	[BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
	[BC_ENS, BC_SPO, BC(3), BC_SPO, BC(4)],
	[BC_STO, BC_SPO, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)],
	[BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)]],
);

$| = 1;

my $maxtest = 0;
for my $counter (@all_tests) {
    my $nt = 3;
    for my $r (values %{$counter->[2]}) {
	$nt ++;
	$nt += scalar @$r if ref $r;
    }
    $counter->[3] = $nt;
    $maxtest += $nt;
}
print "1..$maxtest\n";

my $testnum = 1;
my $rc = new Language::INTERCAL::Rcfile;
for my $tester (@all_tests) {
    my ($name, $in, $out, $nt, $splat, @code) = @$tester;
    my $obj = new Language::INTERCAL::Interpreter($rc);
    $obj->object->setbug(0, 0);
    my $cp = 0;
    my @c = map {
	pack('C*', BC_STS, BC($cp++), BC(1), BC(0), BC(0), @$_);
    } (@code, [BC_GUP]);
    eval {
	$obj->object->source('x');
	$obj->object->code(\@c);
    };
    if (@$) {
	print "not ok ", $testnum++, "\n" for (1..$nt);
	next;
    }
    print "ok ", $testnum++, "\n";
    eval {
	for my $r (keys %$in) {
	    $obj->setreg($r, $in->{$r});
	}
	$obj->setreg('@OSFH', $devnull);
	$obj->setreg('@TRFH', $devnull);
    };
    if (@$) {
	print "not ok ", $testnum++, "\n" for (2..$nt);
	print STDERR "Failed $name\n";
	next;
    }
    print "ok ", $testnum++, "\n";
    eval {
	$obj->start()->run()->stop();
    };
    if (@$) {
	print "not ok ", $testnum++, "\n" for (3..$nt);
	print STDERR "Failed $name\n";
	next;
    }
    my $os = $obj->splat;
    if (defined $os) {
	print defined $splat && $os == $splat ? "" : "not ", "ok ", $testnum++, "\n";
	print STDERR "Failed $name (*$os)\n" unless defined $splat && $os == $splat;
    } else {
	print defined $splat ? "not " : "", "ok ", $testnum++, "\n";
	print STDERR "Failed $name (no splat)\n" if defined $splat;
    }
    for my $r (sort keys %$out) {
	my $v = eval { $obj->getreg($r) };
	my $e = $out->{$r};
	if ($@) {
	    print STDERR "Failed $name\n";
	    print "not ok ", $testnum++, "\n";
	    if (ref $e) {
		print "not ok ", $testnum++, "\n" for @$e;
	    }
	    next;
	}
	if (ref $e) {
	    my @v = eval { map { $_->number } $v->as_list };
	    if (@v != @$e) {
		print STDERR "Failed $name\n";
		print "not ok ", $testnum++, "\n";
		print "not ok ", $testnum++, "\n" for @$e;
		next;
	    }
	    print "ok ", $testnum++, "\n";
	    for (my $i = 0; $i < @v; $i++) {
		print $v[$i] == $e->[$i] ? '' : "not ", "ok ", $testnum++, "\n";
		print STDERR "Failed $name\n" if $v[$i] != $e->[$i];
	    }
	} else {
	    my $ok;
	    if ($e =~ /^\d+$/) {
		my $n = eval { $v->number } || 0;
		$ok = $e == $n;
	    } else {
		my $n = pack('C*', eval { map { $_->number } $v->as_list });
		$ok = $e eq $n;
	    }
	    print $ok ? '' : 'not ', "ok ", $testnum++, "\n";
	    print STDERR "Failed $name\n" unless $ok;
	}
    }
}

sub _str {
    my ($str) = @_;
    return (BC_STR, BC(length $str), unpack('C*', $str));
}