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