]>
iEval git - app-scheme79asm.git/blob - t/App-Scheme79asm.t
5 use Test
::More tests
=> 17;
6 BEGIN { use_ok
('App::Scheme79asm') };
9 my ($args, $input, $expected_verilog, $expected_binary16, $name) = @_;
10 my ($actual, $fh, $asm);
11 open $fh, '>', \
$actual;
12 $asm = App
::Scheme79asm
->new(%$args);
13 $asm->parse_and_print_binary16($input, $fh);
15 $actual = uc join ' ', unpack '(H2)*', $actual;
16 is
$actual, $expected_binary16, "print_binary16 $name";
18 open $fh, '>', \
$actual;
19 $asm = App
::Scheme79asm
->new(%$args);
20 $asm->parse_and_print_verilog($input, $fh);
22 is
$actual, $expected_verilog, "print_verilog $name";
27 $expbin = '00 07 00 00 00 00 01 00 01 00 00 07 01 03 00 00';
29 run_test
{}, '(number 3)', <<'EOF', $expbin, '3';
30 mem[0] <= 0; // (cdr part of NIL)
31 mem[1] <= 0; // (car part of NIL)
32 mem[2] <= 11'b00100000000; // (cdr part of T)
33 mem[3] <= 11'b00100000000; // (car part of T)
34 mem[4] <= 11'd7; // (free storage pointer)
35 mem[5] <= 11'b00100000011; // NUMBER 3
36 mem[6] <= 0; // (result of computation)
39 $expbin = '00 08 00 00 00 00 00 20 00 20 00 08 00 E7 00 00 00 25';
41 run_test
{addr_bits
=> 5}, '(quoted (symbol 5))', <<'EOF', $expbin, '(QUOTE 5)';
42 mem[0] <= 0; // (cdr part of NIL)
43 mem[1] <= 0; // (car part of NIL)
44 mem[2] <= 8'b00100000; // (cdr part of T)
45 mem[3] <= 8'b00100000; // (car part of T)
46 mem[4] <= 8'd8; // (free storage pointer)
47 mem[5] <= 8'b11100111; // QUOTED 7
48 mem[6] <= 0; // (result of computation)
49 mem[7] <= 8'b00100101; // SYMBOL 5
52 $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';
53 run_test
{addr_bits
=> 13}, '(call (more (funcall 0) (proc (var -2))) (number 5))', <<'EOF', $expbin, '((LAMBDA ID (X) X) 5)';
54 mem[ 0] <= 0; // (cdr part of NIL)
55 mem[ 1] <= 0; // (car part of NIL)
56 mem[ 2] <= 16'b0010000000000000; // (cdr part of T)
57 mem[ 3] <= 16'b0010000000000000; // (car part of T)
58 mem[ 4] <= 16'd12; // (free storage pointer)
59 mem[ 5] <= 16'b1100000000000111; // CALL 7
60 mem[ 6] <= 0; // (result of computation)
61 mem[ 7] <= 16'b0000000000001001; // MORE 9
62 mem[ 8] <= 16'b0010000000000101; // NUMBER 5
63 mem[ 9] <= 16'b1110000000000000; // FUNCALL 0
64 mem[10] <= 16'b1000000000001011; // PROC 11
65 mem[11] <= 16'b0101111111111110; // VAR -2
71 memory
=> [0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
75 $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';
77 run_test \
%test, '(call (more (cons 0) (number 11)) (number 10))', <<'EOF', $expbin, '(CONS 10 11)';
78 mem[ 0] <= 0; // (cdr part of NIL)
79 mem[ 1] <= 16'b0000000000000001; // (car part of NIL)
80 mem[ 2] <= 16'b0000000000000010; // (cdr part of T)
81 mem[ 3] <= 16'b0000000000000011; // (car part of T)
82 mem[ 4] <= 16'd14; // (free storage pointer)
83 mem[ 5] <= 16'b1100000000001010; // CALL 10
84 mem[ 6] <= 16'b0000000000000110; // (result of computation)
85 mem[ 7] <= 16'b0000000000000111;
86 mem[ 8] <= 16'b0000000000001000;
87 mem[ 9] <= 16'b0000000000001001;
88 mem[10] <= 16'b0000000000001100; // MORE 12
89 mem[11] <= 16'b0010000000001010; // NUMBER 10
90 mem[12] <= 16'b0110000000000000; // CONS 0
91 mem[13] <= 16'b0010000000001011; // NUMBER 11
94 sub expect_error_like
(&$) {
95 my ($block, $error_re) = @_;
96 my $name = "test error like /$error_re/";
97 my $result = eval { $block->(); 1 };
99 note
'Block did not throw an exception, failing test';
102 like
$@
, qr/$error_re/, $name;
106 expect_error_like
{ run_test
{}, 'symbol' } 'Toplevel is not a list';
107 expect_error_like
{ run_test
{}, '((type is a list) 5)'} 'Type of toplevel is not atom';
108 expect_error_like
{ run_test
{}, '(badtype 5)'} 'No such type';
109 expect_error_like
{ run_test
{}, '(number)'} 'Computed addr is not a number';
110 expect_error_like
{ run_test
{}, '(70000 5)'} 'Type too large';
111 expect_error_like
{ run_test
{}, '(5 700000)'} 'Addr too large';
112 expect_error_like
{ run_test
{addr_bits
=> 20}, '(list 0)' } 'addr_bits ';
113 expect_error_like
{ App
::Scheme79asm
->new->process([5, {}]) } 'Addr of toplevel is not atom';
This page took 0.062788 seconds and 4 git commands to generate.