about summary refs log tree commit diff
path: root/tests.lisp
diff options
context:
space:
mode:
authorVincent Ambo <tazjin@google.com>2020-01-22T21·38+0000
committerVincent Ambo <tazjin@google.com>2020-01-22T21·38+0000
commit47f60d0996ed57d3a3c00b25ddbd8fea04096f90 (patch)
tree809e91ff493b17ef82e6e0de81e1eb7fbb33ec7b /tests.lisp
Squashed 'third_party/lisp/quasiquote_2/' content from commit cac90875d1
git-subtree-dir: third_party/lisp/quasiquote_2
git-subtree-split: cac90875d1f66e9385e559bfebafe6b7808b0930
Diffstat (limited to 'tests.lisp')
-rw-r--r--tests.lisp143
1 files changed, 143 insertions, 0 deletions
diff --git a/tests.lisp b/tests.lisp
new file mode 100644
index 000000000000..6c8ab08cc1af
--- /dev/null
+++ b/tests.lisp
@@ -0,0 +1,143 @@
+(in-package :cl-user)
+
+(defpackage :quasiquote-2.0-tests
+  (:use :cl :quasiquote-2.0 :fiveam)
+  (:export #:run-tests))
+
+(in-package :quasiquote-2.0-tests)
+
+(def-suite quasiquote-2.0)
+(in-suite quasiquote-2.0)
+
+(defun run-tests ()
+  (let ((results (run 'quasiquote-2.0)))
+    (fiveam:explain! results)
+    (unless (fiveam:results-status results)
+      (error "Tests failed."))))
+
+(test basic
+  (is (equal '(nil :just-quote-it!) (multiple-value-list (%codewalk-dig-form '(dig nil)))))
+  (is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig (inject a))))))
+  (is (equal '(nil :just-form-it!) (multiple-value-list (%codewalk-dig-form '(dig 2 (inject 2 a))))))
+  (is (equal '(((((inject b) c (inject d)) car cdr car) (((inject d)) car cdr cdr cdr car)) nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (a (inject b) c (inject d)))))))
+  (is (equal '(nil nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject d))))))))
+  (is (equal '(((((inject 2 d)) car cdr cdr cdr car cdr car)) nil)
+	     (multiple-value-list (%codewalk-dig-form '(dig (dig (a (inject b) c (inject 2 d)))))))))
+  
+(test transform
+  (is (equal '(quote a) (transform-dig-form '(dig a))))
+  (is (equal '(quote a) (transform-dig-form '(dig 2 a))))
+  (is (equal 'a (transform-dig-form '(dig (inject a)))))
+  (is (equal 'a (transform-dig-form '(dig 2 (inject 2 a))))))
+
+(defun foo (b d)
+  (dig (a (inject b) c (inject d))))
+
+(defun foo1-transparent (x)
+  (declare (ignorable x))
+  (dig (dig (a (inject (b (inject x) c))))))
+
+(defun foo1-opaque (x)
+  (declare (ignorable x))
+  (dig (dig (a (oinject (b (inject x) c))))))
+
+(defun foo-recursive (x y)
+  (dig (a (inject (list x (dig (c (inject y))))))))
+  
+
+(test foos
+  (is (equal '(a 1 c 2) (foo 1 2)))
+  (is (equal '(a 100 c 200) (foo 100 200))))
+
+(test opaque-vs-transparent
+  (is (equal '(quote a) (transform-dig-form '(odig a))))
+  (is (equal '(quote a) (transform-dig-form '(odig 2 a))))
+  (is (equal 'a (transform-dig-form '(odig (inject a)))))
+  (is (equal 'a (transform-dig-form '(odig 2 (inject 2 a)))))
+  (is (equal '(odig (inject 2 a)) (eval (transform-dig-form '(dig (odig (inject 2 a)))))))
+  (is (equal '(dig (a (inject (b 3 c)))) (foo1-transparent 3)))
+  (is (equal '(dig (a (oinject (b (inject x) c)))) (foo1-opaque 3))))
+
+(test recursive-compile-time
+  (is (equal '(a (1 (c 2))) (foo-recursive 1 2))))
+	     
+
+(test splicing
+  (is (equal '(a b c d) (eval (transform-dig-form '(dig (a (splice '(b c)) d))))))
+  (is (equal '(b c d) (eval (transform-dig-form '(dig ((splice '(b c)) d))))))
+  (is (equal '(a b c) (eval (transform-dig-form '(dig (a (splice '(b c))))))))
+  (is (equal '(a b) (eval (transform-dig-form '(dig (a (splice nil) b))))))
+  (is (equal '(b) (eval (transform-dig-form '(dig ((splice nil) b))))))
+  (is (equal '(a) (eval (transform-dig-form '(dig (a (splice nil)))))))
+  (is (equal '() (eval (transform-dig-form '(dig ((splice nil)))))))
+  (is (equal '(a b) (eval (transform-dig-form '(dig ((splice '(a b)))))))))
+
+
+(test are-they-macro
+  (is (not (equal '(dig (a b)) (macroexpand-1 '(dig (a b))))))
+  (is (not (equal '(odig (a b)) (macroexpand-1 '(odig (a b)))))))
+
+
+(defmacro triple-var (x)
+  `((inject ,x) (inject ,x) (inject ,x)))
+
+(test correct-order-of-effects
+  (is (equal '(a 1 2 3) (let ((x 0))
+			  (dig (a (inject (incf x)) (inject (incf x)) (inject (incf x)))))))
+  (is (equal '(a (((1))) 2)
+	     (let ((x 0))
+	       (dig (a ((((inject (incf x))))) (inject (incf x))))))))
+
+(test macro-injects
+  (is (equal '(a (3 3 3)) (let ((x 3))
+			    (dig (a (macro-inject (triple-var x)))))))
+  (is (equal '(a (1 2 3)) (let ((x 0))
+			    (dig (a (macro-inject (triple-var (incf x))))))))
+  (macrolet ((frob (form n)
+	       (mapcar (lambda (x)
+			 `(inject ,x))
+		       (make-list n :initial-element form)))
+	     (frob1 (form)
+	       `(frob ,form 4)))
+    (is (equal '(a (1 2 3 4 5))
+	       (let ((x 0))
+		 (dig (a (macro-inject (frob (incf x) 5)))))))
+    (is (equal '(a 1 2 3 4 5)
+	       (let ((x 0))
+		 (dig (a (macro-splice (frob (incf x) 5)))))))
+    (is (equal '(a)
+	       (let ((x 0))
+		 (declare (ignorable x))
+		 (dig (a (macro-splice (frob (incf x) 0)))))))
+    (is (equal '(a frob (incf x) 4)
+	       (let ((x 0))
+		 (declare (ignorable x))
+		 (dig (a (macro-splice (frob1 (incf x))))))))
+    (is (equal '(a 1 2 3 4)
+	       (let ((x 0))
+		 (dig (a (macro-splice-all (frob1 (incf x))))))))))
+    
+	       
+(quasiquote-2.0:enable-quasiquote-2.0)
+
+(test reader
+  (is (equal '(inject x) ',x))
+  (is (equal '(inject 3 x) ',,,x))
+  (is (equal '(splice x) ',@x))
+  (is (equal '(splice 3 x) ',,,@x))
+  (is (equal '(omacro-splice-all 4 x) ',,,,!oma@x))
+  (is (equal '(inject 4 oma@x) ',,,,oma@x)))
+
+(test macro-splices
+  (macrolet ((splicer (x)
+	       ``(splice ,x)))
+    (is (equal '(a 1 2 3) (let ((x '(1 2 3)))
+			    `(a ,!m(splicer x)))))))
+
+(test repeated-splices
+  (is (equal '(a) `(a ,@nil ,@nil ,@nil ,@nil)))
+  (is (equal '(a b c d e f g) `(a ,@(list 'b 'c) ,@(list 'd 'e) ,@nil ,@(list 'f 'g)))))
+
+  
\ No newline at end of file