Add tests

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")))

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"))