klisp

commit b44185a9ef0aaf2bbc5238cc639013b86bc61d21
parent 449d627ad216d5de2a0a1f9d27e0904d84d0ea0a
Author: Oto Havle <havleoto@gmail.com>
Date:   Sat, 10 Dec 2011 16:09:18 +0100

Bugfix: unmark_tree now handles vectors

Diffstat:
M
src/kghelpers.h
 | 
9
++++++++-
M
src/tests/eq-equal.k
 | 
29
+++++++++++++++++++++++++++++

2 files changed, 37 insertions(+), 1 deletion(-)
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -18,6 +18,7 @@
 #include "klisp.h"
 #include "kerror.h"
 #include "kpair.h"
+#include "kvector.h"
 #include "kapplicative.h"
 #include "koperative.h"
 #include "kcontinuation.h"
@@ -328,7 +329,13 @@ inline void unmark_tree(klisp_State *K, TValue obj)
 	    kunmark(obj);
 	    ks_spush(K, kcdr(obj));
 	    ks_spush(K, kcar(obj));
-	}
+	} else if (ttisvector(obj) && kis_marked(obj)) {
+            kunmark(obj);
+            uint32_t i = kvector_size(obj);
+            const TValue *array = kvector_buf(obj);
+            while(i-- > 0)
+                ks_spush(K, array[i]);
+        }
     }
 }
 
diff --git a/src/tests/eq-equal.k b/src/tests/eq-equal.k
@@ -266,6 +266,35 @@
 ($check-not-predicate (equal? (vector 1 2 3) (vector 1 2)))
 ($check-not-predicate (equal? (vector 1 2 3) (vector 2 3)))
 
+($check equal?
+  ($let ((v (vector 1 2)) (w (vector 1 3)))
+    (list (equal? v w) (equal? v w) (equal? v w) (equal? v w)))
+  (list #f #f #f #f))
+
+($check-predicate
+  ($let* ((a (make-vector 100 1))
+          (b (make-vector 100 1))
+          (v (make-vector 100 a))
+          (w (make-vector 100 b)))
+    (equal? v w)))
+
+($check-not-predicate
+  ($let* ((a (make-vector 100 1))
+          (b (make-vector 100 1))
+          (c (make-vector 100 1))
+          (v (make-vector 100 a))
+          (w (make-vector 100 b)))
+    (vector-set! c 50 2)
+    (vector-set! v 50 c)
+    (equal? v w)))
+
+
+($check-not-predicate
+  ($let ((v (make-vector 100000 #f))
+         (w (make-vector 100000 #f)))
+      (vector-set! v 50000 #t)
+      (equal? v w)))
+
 ($check-predicate
   ($let* ((v1 (vector 1))
           (v2 (vector 1 v1))