Complete test coverage of assembler

diff --git a/lib/App/Scheme79asm.pm b/lib/App/Scheme79asm.pm
index f76b834ea6c463ae7b4a03dce6baaf097612a358..0333b700dd9361da79b962c70a0ca48b073c016c 100644 (file)
--- a/lib/App/Scheme79asm.pm
+++ b/lib/App/Scheme79asm.pm
@@ -57,17 +57,7 @@ sub process {
 
        $addr = $self->process($addr) if ref $addr eq 'ARRAY';
        die 'Addr of toplevel is not atom: ', Dumper($addr), "\n" unless scalarp($addr);
-
        my ($comment_type, $comment_addr) = ($type, $addr);
-
-       unless (looks_like_number $addr) { # is symbol
-               unless (exists $self->{symbols}{$addr}) {
-                       $self->{symbols}{$addr} = $self->{nsymbols};
-                       $self->{nsymbols}++;
-               }
-               $addr = $self->{symbols}{$addr}
-       }
-
        die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr;
 
        if (!looks_like_number $type) {
@@ -114,15 +104,13 @@ sub new {
        $args{addr_bits} //= 8;
        $args{freeptr} //= 6;
        $args{memory} //= [0, 0, (1<<$args{addr_bits}), (1<<$args{addr_bits}), 0, 0, 0];
-       $args{symbols}{T} = 2;
-       $args{nsymbols} = 3;
        $args{comment} = ['(cdr part of NIL)', '(car part of NIL)', '(cdr part of T)', '(car part of T)', '(free storage pointer)', '', '(result of computation)'];
        bless \%args, $class
 }
 
 sub print_binary16 {
        my ($self, $fh) = @_;
-       $fh //= \*STDOUT;
+       $fh //= \*STDOUT; # uncoverable condition right
 
        die "addr_bits + type_bits >= 16\n"if $self->{addr_bits} + $self->{type_bits} > 16;
 
@@ -135,7 +123,7 @@ sub print_binary16 {
 
 sub print_verilog {
        my ($self, $fh) = @_;
-       $fh //= \*STDOUT;
+       $fh //= \*STDOUT; # uncoverable condition right
 
        my $bits = $self->{type_bits} + $self->{addr_bits};
        my $index_length = length $#{$self->{memory}};
@@ -150,7 +138,10 @@ sub print_verilog {
                }
                my $spaces = ' ' x ($bits + 5 - (length $val));
                $index = sprintf $index_format, $index;
-               say $fh "mem[$index] <= $val;$spaces // $comment"
+
+               print $fh "mem[$index] <= $val;";
+               print $fh "$spaces // $comment" if defined $comment;
+               print $fh "\n";
        }
 
 }
@@ -192,7 +183,7 @@ The SIMPLE processor expects input in a particular tagged-pointer
 format. This module takes a string containing a sequence of
 S-expressions. Each S-expression is a list of one of three types:
 
-C<(tag value)>, for example C<(symbol nil)>, represents a value to be
+C<(tag value)>, for example C<(symbol 2)>, represents a value to be
 put in memory (for example a number, or a symbol, or a variable
 reference).
 
@@ -295,16 +286,6 @@ C<freeptr>.
 The initial comments for memory entries. C<< $comment->[$i] >> is the
 comment for C<< $memory->[$i] >>.
 
-=item symbols
-
-The initial symbol map, as a hashref from symbol name to the index of
-that symbol. Defaults to C<< {T => 2} >>.
-
-=item nsymbols
-
-The number to give to the "next" symbol (default 3, because T is
-defined to be 2).
-
 =back
 
 =item $asm->B<parse>(I<$string>)

diff --git a/t/App-Scheme79asm.t b/t/App-Scheme79asm.t
index 8e7e72c8f5d602d589be22334c71db32483dcd5b..42caff187997b8f1f73ed30c4391a2d5c5c15a4a 100644 (file)
--- a/t/App-Scheme79asm.t
+++ b/t/App-Scheme79asm.t
@@ -2,20 +2,43 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 17;
 BEGIN { use_ok('App::Scheme79asm') };
 
 sub run_test {
-       my ($args, $input, $expected, $name) = @_;
-       my $actual = '';
-       open my $fh, '>', \$actual;
-       my $asm = App::Scheme79asm->new(%$args);
+       my ($args, $input, $expected_verilog, $expected_binary16, $name) = @_;
+       my ($actual, $fh, $asm);
+       open $fh, '>', \$actual;
+       $asm = App::Scheme79asm->new(%$args);
+       $asm->parse_and_print_binary16($input, $fh);
+       close $fh;
+       $actual = uc join ' ', unpack '(H2)*', $actual;
+       is $actual, $expected_binary16, "print_binary16 $name";
+
+       open $fh, '>', \$actual;
+       $asm = App::Scheme79asm->new(%$args);
        $asm->parse_and_print_verilog($input, $fh);
        close $fh;
-       is $actual, $expected, $name
+       is $actual, $expected_verilog, "print_verilog $name";
 }
 
-run_test {addr_bits => 5}, '(quoted (symbol 5))', <<'EOF', '(QUOTE 5)';
+my $expbin;
+
+$expbin = '00 07 00 00 00 00 01 00 01 00 00 07 01 03 00 00';
+
+run_test {}, '(number 3)', <<'EOF', $expbin, '3';
+mem[0] <= 0;                // (cdr part of NIL)
+mem[1] <= 0;                // (car part of NIL)
+mem[2] <= 11'b00100000000;  // (cdr part of T)
+mem[3] <= 11'b00100000000;  // (car part of T)
+mem[4] <= 11'd7;            // (free storage pointer)
+mem[5] <= 11'b00100000011;  // NUMBER 3
+mem[6] <= 0;                // (result of computation)
+EOF
+
+$expbin = '00 08 00 00 00 00 00 20 00 20 00 08 00 E7 00 00 00 25';
+
+run_test {addr_bits => 5}, '(quoted (symbol 5))', <<'EOF', $expbin, '(QUOTE 5)';
 mem[0] <= 0;             // (cdr part of NIL)
 mem[1] <= 0;             // (car part of NIL)
 mem[2] <= 8'b00100000;   // (cdr part of T)
@@ -26,7 +49,8 @@ mem[6] <= 0;             // (result of computation)
 mem[7] <= 8'b00100101;   // SYMBOL 5
 EOF
 
-run_test {addr_bits => 13}, '(call (more (funcall 0) (proc (var -2))) (number 5))', <<'EOF', '((LAMBDA ID (X) X) 5)';
+$expbin = '00 0C 00 00 00 00 20 00 20 00 00 0C C0 07 00 00 00 09 20 05 E0 00 80 0B 5F FE';
+run_test {addr_bits => 13}, '(call (more (funcall 0) (proc (var -2))) (number 5))', <<'EOF', $expbin, '((LAMBDA ID (X) X) 5)';
 mem[ 0] <= 0;                     // (cdr part of NIL)
 mem[ 1] <= 0;                     // (car part of NIL)
 mem[ 2] <= 16'b0010000000000000;  // (cdr part of T)
@@ -40,3 +64,50 @@ mem[ 9] <= 16'b1110000000000000;  // FUNCALL 0
 mem[10] <= 16'b1000000000001011;  // PROC 11
 mem[11] <= 16'b0101111111111110;  // VAR -2
 EOF
+
+my %test = (
+       addr_bits => 13,
+       type_bits => 3,
+       memory => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
+       freeptr => 9
+);
+
+$expbin = '00 0E 00 00 00 01 00 02 00 03 00 0E C0 0A 00 06 00 07 00 08 00 09 00 0C 20 0A 60 00 20 0B';
+
+run_test \%test, '(call (more (cons 0) (number 11)) (number 10))', <<'EOF', $expbin, '(CONS 10 11)';
+mem[ 0] <= 0;                     // (cdr part of NIL)
+mem[ 1] <= 16'b0000000000000001;  // (car part of NIL)
+mem[ 2] <= 16'b0000000000000010;  // (cdr part of T)
+mem[ 3] <= 16'b0000000000000011;  // (car part of T)
+mem[ 4] <= 16'd14;                // (free storage pointer)
+mem[ 5] <= 16'b1100000000001010;  // CALL 10
+mem[ 6] <= 16'b0000000000000110;  // (result of computation)
+mem[ 7] <= 16'b0000000000000111;
+mem[ 8] <= 16'b0000000000001000;
+mem[ 9] <= 16'b0000000000001001;
+mem[10] <= 16'b0000000000001100;  // MORE 12
+mem[11] <= 16'b0010000000001010;  // NUMBER 10
+mem[12] <= 16'b0110000000000000;  // CONS 0
+mem[13] <= 16'b0010000000001011;  // NUMBER 11
+EOF
+
+sub expect_error_like (&$) {
+       my ($block, $error_re) = @_;
+       my $name = "test error like /$error_re/";
+       my $result = eval { $block->(); 1 };
+       if ($result) {
+               note 'Block did not throw an exception, failing test';
+               fail $name;
+       } else {
+               like $@, qr/$error_re/, $name;
+       }
+}
+
+expect_error_like { run_test {}, 'symbol' } 'Toplevel is not a list';
+expect_error_like { run_test {}, '((type is a list) 5)'} 'Type of toplevel is not atom';
+expect_error_like { run_test {}, '(badtype 5)'} 'No such type';
+expect_error_like { run_test {}, '(number)'} 'Computed addr is not a number';
+expect_error_like { run_test {}, '(70000 5)'} 'Type too large';
+expect_error_like { run_test {}, '(5 700000)'} 'Addr too large';
+expect_error_like { run_test {addr_bits => 20}, '(list 0)' } 'addr_bits ';
+expect_error_like { App::Scheme79asm->new->process([5, {}]) } 'Addr of toplevel is not atom';