From 744f5c2a92054cb2a39b5766042f6f44373e2401 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 24 Mar 2018 18:08:17 +0200 Subject: [PATCH] Complete test coverage of assembler --- lib/App/Scheme79asm.pm | 33 ++++------------ t/App-Scheme79asm.t | 87 ++++++++++++++++++++++++++++++++++++++---- 2 files changed, 86 insertions(+), 34 deletions(-) diff --git a/lib/App/Scheme79asm.pm b/lib/App/Scheme79asm.pm index f76b834..0333b70 100644 --- 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. 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(I<$string>) diff --git a/t/App-Scheme79asm.t b/t/App-Scheme79asm.t index 8e7e72c..42caff1 100644 --- 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'; -- 2.30.2