pit: Add tests, fix binding bugHEADmaster

37 files changed, 37 insertions, 7 deletions

diff --git a/pit/Makefile b/pit/Makefile
index 2eeb084..388044a 100644
--- a/pit/Makefile
+++ b/pit/Makefile
@@ -37,10 +37,13 @@ libdir ?= $(exec_prefix)/lib
 
 GDBFLAGS ?=
 
-.PHONY: all clean install install-bin install-headers install-core install-native check-syntax gdb
+.PHONY: all test clean install install-bin install-headers install-core install-native check-syntax gdb
 
 all: $(EXE) $(LIB_CORE) $(LIB_NATIVE)
 
+test: $(EXE)
+	@find test/ -type f -exec ./$(EXE) {} \;
+
 $(EXE): $(BUILD)/main.o $(LIB_NATIVE) $(LIB_CORE)
 	$(CC) -o $@ $^ $(LDFLAGS)
 
diff --git a/pit/test/6502.pit b/pit/examples/6502.pit
index eb5a4e8..eb5a4e8 100644
--- a/pit/test/6502.pit
+++ b/pit/examples/6502.pit
diff --git a/pit/test/array.pit b/pit/examples/array.pit
index 976f70d..976f70d 100644
--- a/pit/test/array.pit
+++ b/pit/examples/array.pit
diff --git a/pit/test/backtrace.pit b/pit/examples/backtrace.pit
index 8a44951..8a44951 100644
--- a/pit/test/backtrace.pit
+++ b/pit/examples/backtrace.pit
diff --git a/pit/test/bif.pit b/pit/examples/bif.pit
index 81a1248..81a1248 100644
--- a/pit/test/bif.pit
+++ b/pit/examples/bif.pit
diff --git a/pit/test/broken.pit b/pit/examples/broken.pit
index 09f4afc..09f4afc 100644
--- a/pit/test/broken.pit
+++ b/pit/examples/broken.pit
diff --git a/pit/test/compile.pit b/pit/examples/compile.pit
index 37d7f57..37d7f57 100644
--- a/pit/test/compile.pit
+++ b/pit/examples/compile.pit
diff --git a/pit/test/error.pit b/pit/examples/error.pit
index 58b7d99..58b7d99 100644
--- a/pit/test/error.pit
+++ b/pit/examples/error.pit
diff --git a/pit/test/error2.pit b/pit/examples/error2.pit
index 63ab173..63ab173 100644
--- a/pit/test/error2.pit
+++ b/pit/examples/error2.pit
diff --git a/pit/test/fold.pit b/pit/examples/fold.pit
index 89031d0..89031d0 100644
--- a/pit/test/fold.pit
+++ b/pit/examples/fold.pit
diff --git a/pit/test/gc.pit b/pit/examples/gc.pit
index 28eed50..28eed50 100644
--- a/pit/test/gc.pit
+++ b/pit/examples/gc.pit
diff --git a/pit/examples/infinite.pit b/pit/examples/infinite.pit
new file mode 100644
index 0000000..f815821
--- /dev/null
+++ b/pit/examples/infinite.pit
@@ -0,0 +1,4 @@
+(progn
+  (defun! foo ()
+    (foo))
+  foo)
\ No newline at end of file
diff --git a/pit/test/int.pit b/pit/examples/int.pit
index 65646af..65646af 100644
--- a/pit/test/int.pit
+++ b/pit/examples/int.pit
diff --git a/pit/test/loadpath.pit b/pit/examples/loadpath.pit
index 5f8bcf8..5f8bcf8 100644
--- a/pit/test/loadpath.pit
+++ b/pit/examples/loadpath.pit
diff --git a/pit/test/nonbroken.pit b/pit/examples/nonbroken.pit
index 350f64f..350f64f 100644
--- a/pit/test/nonbroken.pit
+++ b/pit/examples/nonbroken.pit
diff --git a/pit/test/recurse.pit b/pit/examples/recurse.pit
index 8e1f784..8e1f784 100644
--- a/pit/test/recurse.pit
+++ b/pit/examples/recurse.pit
diff --git a/pit/test/struct.pit b/pit/examples/struct.pit
index 9e35654..9e35654 100644
--- a/pit/test/struct.pit
+++ b/pit/examples/struct.pit
diff --git a/pit/test/test.pit b/pit/examples/test.pit
index ef13abb..ef13abb 100644
--- a/pit/test/test.pit
+++ b/pit/examples/test.pit
diff --git a/pit/test/test10.pit b/pit/examples/test10.pit
index 0eea605..0eea605 100644
--- a/pit/test/test10.pit
+++ b/pit/examples/test10.pit
diff --git a/pit/test/test11.pit b/pit/examples/test11.pit
index 83d4816..83d4816 100644
--- a/pit/test/test11.pit
+++ b/pit/examples/test11.pit
diff --git a/pit/test/test2.pit b/pit/examples/test2.pit
index a86f8d2..a86f8d2 100644
--- a/pit/test/test2.pit
+++ b/pit/examples/test2.pit
diff --git a/pit/test/test3.pit b/pit/examples/test3.pit
index 1964242..1964242 100644
--- a/pit/test/test3.pit
+++ b/pit/examples/test3.pit
diff --git a/pit/test/test4.pit b/pit/examples/test4.pit
index ef8e04c..ef8e04c 100644
--- a/pit/test/test4.pit
+++ b/pit/examples/test4.pit
diff --git a/pit/test/test5.pit b/pit/examples/test5.pit
index 2ad3675..2ad3675 100644
--- a/pit/test/test5.pit
+++ b/pit/examples/test5.pit
diff --git a/pit/test/test6.pit b/pit/examples/test6.pit
index cb04f22..cb04f22 100644
--- a/pit/test/test6.pit
+++ b/pit/examples/test6.pit
diff --git a/pit/test/test7.pit b/pit/examples/test7.pit
index 48d2c2c..48d2c2c 100644
--- a/pit/test/test7.pit
+++ b/pit/examples/test7.pit
diff --git a/pit/test/test8.pit b/pit/examples/test8.pit
index 3b41d7a..3b41d7a 100644
--- a/pit/test/test8.pit
+++ b/pit/examples/test8.pit
diff --git a/pit/test/test9.pit b/pit/examples/test9.pit
index daf1686..daf1686 100644
--- a/pit/test/test9.pit
+++ b/pit/examples/test9.pit
diff --git a/pit/test/thebug.pit b/pit/examples/thebug.pit
index ad87bd7..ad87bd7 100644
--- a/pit/test/thebug.pit
+++ b/pit/examples/thebug.pit
diff --git a/pit/test/thebug2.pit b/pit/examples/thebug2.pit
index 2376ff8..2376ff8 100644
--- a/pit/test/thebug2.pit
+++ b/pit/examples/thebug2.pit
diff --git a/pit/test/x86.pit b/pit/examples/x86.pit
index 2aa8d89..2aa8d89 100644
--- a/pit/test/x86.pit
+++ b/pit/examples/x86.pit
diff --git a/pit/test/y.pit b/pit/examples/y.pit
index 5e9218b..5e9218b 100644
--- a/pit/test/y.pit
+++ b/pit/examples/y.pit
diff --git a/pit/src/native.c b/pit/src/native.c
index 7d61a50..e776f38 100644
--- a/pit/src/native.c
+++ b/pit/src/native.c
@@ -188,6 +188,17 @@ static pit_value impl_diagnostics(pit_runtime *rt, pit_value args, void *data) {
     fprintf(stderr, "value allocs: %ld\n", rt->heap->next);
     return PIT_NIL;
 }
+static pit_value impl_assert(pit_runtime *rt, pit_value args, void *data) {
+    (void) data;
+    pit_value msg = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args);
+    pit_value expected = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args);
+    pit_value actual = pit_value_cons_car(rt, args); args = pit_value_cons_cdr(rt, args);
+    if (!pit_value_equal(rt, expected, actual)) {
+        pit_fprintf(rt, stderr, "assertion %v failed!\nexpected: %v\nactual: %v\n", msg, expected, actual);
+        exit(1);
+    }
+    return actual;
+}
 static pit_value impl_print(pit_runtime *rt, pit_value args, void *data) {
     (void) data;
     pit_value x = pit_value_cons_car(rt, args);
@@ -259,6 +270,7 @@ void pit_install_library_io(pit_runtime *rt) {
     pit_symtab_set(rt, pit_symtab_intern_cstr(rt, "*load-path*"), load_path);
     /* diagnostics */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "diagnostics!"), pit_value_nativefunc_new(rt, impl_diagnostics));
+    pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "assert!"), pit_value_nativefunc_new(rt, impl_assert));
     /* stream IO */
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "print!"), pit_value_nativefunc_new(rt, impl_print));
     pit_symtab_fset(rt, pit_symtab_intern_cstr(rt, "princ!"), pit_value_nativefunc_new(rt, impl_princ));
diff --git a/pit/src/parser.c b/pit/src/parser.c
index 6c633c9..2541344 100644
--- a/pit/src/parser.c
+++ b/pit/src/parser.c
@@ -80,9 +80,10 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) {
         return PIT_NIL;
     case PIT_LEX_TOKEN_LPAREN: {
         pit_value ret = PIT_NIL;
+        pit_value term = PIT_NIL;
         while (!match(st, PIT_LEX_TOKEN_RPAREN)) {
             if (match(st, PIT_LEX_TOKEN_DOT)) {
-                ret = pit_parse(rt, st, eof);
+                term = pit_parse(rt, st, eof);
                 if (match(st, PIT_LEX_TOKEN_RPAREN)) {
                     break;
                 } else {
@@ -97,14 +98,17 @@ pit_value pit_parse(pit_runtime *rt, pit_parser *st, bool *eof) {
                 return PIT_NIL; /* if we hit an error, stop!*/
             }
         }
-        ret = pit_value_list_reverse(rt, ret);
-        if (pit_value_sort(ret) == PIT_VALUE_SORT_REF) {
+        while (ret != PIT_NIL) {
+            term = pit_value_cons(rt, pit_value_cons_car(rt, ret), term);
+            ret = pit_value_cons_cdr(rt, ret);
+        }
+        if (pit_value_sort(term) == PIT_VALUE_SORT_REF) {
             pit_annotation a = {0};
             a.line = rt->source_line;
             a.column = rt->source_column;
-            pit_annotation_set(rt, pit_value_as_ref(rt, ret), a);
+            pit_annotation_set(rt, pit_value_as_ref(rt, term), a);
         }
-        return ret;
+        return term;
     }
     case PIT_LEX_TOKEN_LSQUARE: {
         pit_value ret = PIT_NIL;
diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c
index 3cd1c1f..43c8998 100644
--- a/pit/src/runtime/eval.c
+++ b/pit/src/runtime/eval.c
@@ -38,7 +38,7 @@ static pit_value vm_pop(pit_runtime *rt) {
 }
 
 static pit_value vm_bind_or_replace(pit_runtime *rt, pit_value nm, pit_value cell, pit_value bound) {
-    if (pit_value_list_contains_eq(rt, nm, bound)) {
+    if (pit_value_list_contains_eq(rt, nm, bound) != PIT_NIL) {
         /* if we're already responsible for unbinding this symbol (e.g. in a tail call), */
         /* simply replace the old binding - this keeps the binding stack from growing for TCO purposes */
         pit_symtab_replace(rt, nm, cell);
diff --git a/pit/test/core.pit b/pit/test/core.pit
new file mode 100644
index 0000000..51e28a7
--- /dev/null
+++ b/pit/test/core.pit
@@ -0,0 +1 @@
+(assert! 'cons '(1 . 2) (cons 1 2))
diff --git a/pit/test/horriblebindingbug.pit b/pit/test/horriblebindingbug.pit
new file mode 100644
index 0000000..7f48b69
--- /dev/null
+++ b/pit/test/horriblebindingbug.pit
@@ -0,0 +1,6 @@
+(defun! broken (ops) nil)
+(defun! test (ops)
+  (let ((oldops ops))
+    (broken 'foo)
+    (assert! 'horriblebindingbug oldops ops)))
+(test '(1 2 3))