Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
75 lines (56 sloc) 2.38 KB
;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; tests.lisp -- tests for CL-INDETERMINISM
;;;
;;; Copyright (c) 2013 by Alexander Popolitov.
;;;
;;; See COPYING for details.
(in-package :cl-user)
(defpackage :cl-indeterminism-tests
(:use :cl :cl-indeterminism :hu.dwim.walker :fiveam)
(:export #:run-tests))
(in-package :cl-indeterminism-tests)
(def-suite indeterminism)
(in-suite indeterminism)
(defun run-tests ()
(let ((results (run 'indeterminism)))
(fiveam:explain! results)
(unless (fiveam:results-status results)
(error "Tests failed."))))
(defmacro list-the-undefs (&body body &environment env)
`(list ,@(mapcar (lambda (x) `(quote ,x))
(find-undefs `(progn ,@body) :env env))))
(test basic
(is (equal '((:functions foo) (:variables baz bar))
(find-undefs '(foo bar baz))))
(is (equal '((:functions foo) (:variables))
(let ((bar 1) (baz 2)) (declare (ignore bar baz)) (find-undefs '(foo bar baz)))))
(is (equal '((:functions foo) (:variables baz bar))
(let ((bar 1) (baz 2)) (declare (ignore bar baz)) (find-undefs '(foo bar baz) :env :null)))))
(test macro-basic
(is (equal '((:functions foo) (:variables baz bar))
(list-the-undefs (foo bar baz))))
(is (equal '((:functions foo) (:variables))
(let ((bar 1) (baz 2)) (declare (ignore bar baz)) (list-the-undefs (foo bar baz))))))
(test transformation-on-the-fly
(is (equal '(:a 'b 'c)
(let ((*variable-transformer* (lambda (x) `(quote ,x)))
(*function-transformer* (lambda (x) (if (keywordp (car x))
(fail-transform)
`(,(intern (string (car x)) "KEYWORD") ,@(cdr x))))))
(macroexpand-all-transforming-undefs '(a b c))))))
(test transformation-on-the-fly-nontriv-lexenv
(is (equal '(a b 'c) (let ((*variable-transformer* (lambda (x) `(quote ,x))))
(let ((b 1))
(macroexpand-all-transforming-undefs '(a b c)))))))
(defmacro autoquoter (form &environment env)
(let ((*variable-transformer* (lambda (x) `(quote ,x))))
(macroexpand-cc-all-transforming-undefs form :env env)))
(defun autoquoter-1 ()
(autoquoter (list b c)))
(defun autoquoter-2 ()
(let ((b 1))
(autoquoter (list b c))))
(test cc-transformation-on-the-fly
(is (equal '(b c) (autoquoter-1)))
(is (equal '(1 c) (autoquoter-2))))