diff --git a/compiler.scm b/compiler.scm index 06f6e80..a64337b 100644 --- a/compiler.scm +++ b/compiler.scm @@ -166,6 +166,10 @@ ; (system "cargo run --release --bin wasm-compile rts/modules/compiled.wat modules/out.wat") (system "/Users/pancy/Code/practical-webassembly/wabt/bin/wat2wasm modules/compiled.wat -o bin/compiled.wasm"))) +(define (compile-to-binary program) + (begin (compile-to-wasm program) + (system "cd rts; cargo build"))) + (define (compile-and-run program) (begin (compile-to-wasm program) (system "cd rts; cargo run"))) diff --git a/rts b/rts index 37b0040..cde8469 160000 --- a/rts +++ b/rts @@ -1 +1 @@ -Subproject commit 37b00405843f1bac91d1a8f74ad989153ff2b9c1 +Subproject commit cde8469ee26c6ff69b613c61b0c08b9f62f2c9cf diff --git a/tests.scm b/tests.scm new file mode 100644 index 0000000..0a174b8 --- /dev/null +++ b/tests.scm @@ -0,0 +1,93 @@ +(use-modules (ice-9 popen) (ice-9 format) (ice-9 textual-ports)) +(include "compiler.scm") + +(define (pad-both str length pad-char) + (let* ((str-length (string-length str)) + (total-padding (- length str-length)) + (left-padding (quotient total-padding 2)) + (right-padding (- total-padding left-padding))) + (if (<= total-padding 0) + str + (string-append + (make-string left-padding pad-char) + str + (make-string right-padding pad-char))))) + +(define (compile-and-run-for-result pgm) + (begin (compile-to-binary pgm) + (chdir "rts") + (let* ((port (open-input-pipe "./target/debug/rts")) + (data (get-string-all port))) + (chdir "../") + (close-pipe port) + (string-trim-both data)))) + +(define (test-section name) + (display (pad-both (format #f " ~a " name) 70 #\#)) (newline)) + +(define (test-case pgm result) + (let ((res (compile-and-run-for-result pgm))) + (if (equal? res result) + (simple-format #t "success: ~a" pgm) + (simple-format #t "FAILURE: ~a (~a | ~a)" pgm res result)) + (newline))) + +(begin + (test-section "Immediates: Fixnum") + (test-case 1 "1") + (test-case -17 "-17") + (test-case 299999 "299999") + (test-case 0 "0") + + (test-section "Immediates: Char") + (test-case #\a "#\\a") + + (test-section "Immediates: Boolean") + (test-case #t "#t") + (test-case #f "#f") + + (test-section "Integer Unary Primitives") + (test-case '(primcall add1 0) "1") + (test-case '(primcall add1 7) "8") + (test-case '(primcall add1 -1) "0") + (test-case '(primcall add1 -1000) "-999") + + (test-case '(primcall sub1 0) "-1") + (test-case '(primcall boolean? -12356) "#f") + (test-case '(primcall boolean? #t) "#t") + (test-case '(primcall boolean? #f) "#t") + (test-case '(primcall boolean? #\q) "#f") + + (test-case '(primcall char? 0) "#f") + (test-case '(primcall char? 1) "#f") + (test-case '(primcall char? #\a) "#t") + (test-case '(primcall char? #t) "#f") + (test-case '(primcall char? #\f) "#t") + (test-case '(primcall char? #\q) "#t") + + (test-section "Binary Integer Ops") + (test-case '(primcall + 1 2) "3") + (test-case '(primcall + -1 1) "0") + (test-case '(primcall + -127 -909) "-1036") + + (test-case '(primcall - 123 23) "100") + (test-case '(primcall - 4 8) "-4") + + (test-case '(primcall * 1000 1000) "1000000") + (test-case '(primcall * 8 -2) "-16") + + (test-case '(primcall = 2 3) "#f") + (test-case '(primcall = 3 3) "#t") + (test-case '(primcall = 0 9) "#f") + (test-case '(primcall = -7 -7) "#t") + + (test-case '(primcall < -7 7) "#t") + (test-case '(primcall < -7 0) "#t") + (test-case '(primcall < -7 -2) "#t") + (test-case '(primcall < 0 5) "#t") + (test-case '(primcall < 0 -5) "#f") + (test-case '(primcall < 1 5) "#t") + + (test-section "Other Binary Ops") + (test-case '(primcall char=? #\a #\b) "#f") + (test-case '(primcall char=? #\a #\a) "#t"))