diff --git a/test-unit/additional-definitions.lisp b/test-unit/additional-definitions.lisp deleted file mode 100644 index 04846f6e85ac00b600a64844c3b8c501a797833a..0000000000000000000000000000000000000000 --- a/test-unit/additional-definitions.lisp +++ /dev/null @@ -1,51 +0,0 @@ -;; Test functions. -;; Liam Healy Sat Apr 22 2006 - 16:52 -;; Time-stamp: <2009-01-26 21:34:35EST additional-definitions.lisp> -;; $Id: $ - -;;; Interface with lisp-unit, add a definition for comparing floating -;;; point numbers and a form for generating floating point tests. - -(in-package :lisp-unit) - -(defparameter *zero-threshold* 1.0d-12 - "Threshold below which a number is to be considered zero.") - -(defparameter *acceptable-fraction-error* 1.0d-12 - "Fractional error which is considered acceptable when - comparing floating point numbers.") - -(defun fp-equal (fp1 fp2) - "The floats fp1 and fp2 are to be considered equal." - ;; For now, fp1 and fp2 must be actual floats and not nans/infs. - (or (and (<= (abs fp1) *zero-threshold*) - (<= (abs fp2) *zero-threshold*)) - (<= (abs (/ (- fp1 fp2) fp1)) *acceptable-fraction-error*))) - -(defun numerical-equal (result1 result2) - (and - (or - (typep result1 'vector) (typep result2 'vector) - (typep result1 'complex) (typep result2 'complex) - (typep result1 'array) (typep result2 'array) - (eql (type-of result1) (type-of result2))) - (typecase result1 - (integer (= result1 result2)) - (float (fp-equal result1 result2)) - (complex (and (fp-equal (realpart result1) (realpart result2)) - (fp-equal (imagpart result1) (imagpart result2)))) - (sequence - (and (eql (length result1) (length result2)) - (every #'numerical-equal result1 result2))) - (array - (and (= (array-rank result1) (array-rank result2) 2) - (loop for i below (array-dimension result1 0) - always - (loop for j below (array-dimension result1 1) - always (numerical-equal (aref result1 i j) - (aref result2 i j))))))))) - -(defmacro assert-numerical-equal (expected form &rest extras) - (lisp-unit::expand-assert - :equal form form expected extras - :test #'numerical-equal)) diff --git a/test-unit/floating-point-assertions.lisp b/test-unit/floating-point-assertions.lisp deleted file mode 100644 index c0328a70f2f95c659af72dcbc262af5fcc34b0c3..0000000000000000000000000000000000000000 --- a/test-unit/floating-point-assertions.lisp +++ /dev/null @@ -1,133 +0,0 @@ -;;;; References -;;;; [NumLinAlg] James W. Demmel "Applied Numerical Linear Algebra", -;;;; Society for Industrial and Applied Mathematics, 1997 -;;;; ISBN: 0-89871-389-7 - -(common-lisp:in-package :lisp-unit) - -(defparameter *epsilon* nil - "Set the error epsilon if the defaults are not acceptable.") - -(defparameter *significant-figures* 4 - "Default to 4 significant figures.") - -;;; (ROUNDOFF-ERROR x y) => number -(defun roundoff-error (exact approximate) - "Return the error delta between the exact and approximate floating -point value." - ;; [NumLinAlg] : Equation 1.1, pg. 12 - (abs (if (or (zerop exact) (zerop approximate)) - (+ exact approximate) - (- (/ approximate exact) 1.0)))) - -;;; (FLOAT-EQUAL float1 float2 &optional epsilon) => true or false -(defun float-equal (float1 float2 &optional (epsilon *epsilon*)) - "Return true if the absolute difference between float1 and float2 is -less than some epsilon." - (when (and (floatp float1) (floatp float2)) - (cond - ((and (zerop float1) (zerop float2))) - (epsilon - (> epsilon (roundoff-error float1 float2))) - ((and (typep float1 'double-float) (typep float2 'double-float)) - (> (* 2.0 double-float-epsilon) (roundoff-error float1 float2))) - ((or (typep float1 'single-float) (typep float2 'single-float)) - (> (* 2.0 single-float-epsilon) (roundoff-error float1 float2))) - (t nil)))) - -(defmacro assert-float-equal (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'float-equal)) - -;;; (COMPLEX-EQUAL complex1 complex2 &optional epsilon) => true or false -(defun complex-equal (complex1 complex2 &optional (epsilon *epsilon*)) - "Return true if the absolute difference between Re(complex1), -Re(complex2) and the absolute difference between Im(complex1), -Im(complex2) is less than epsilon." - (and - (typep complex1 '(complex float)) - (typep complex2 '(complex float)) - (float-equal (realpart complex1) (realpart complex2) epsilon) - (float-equal (imagpart complex1) (imagpart complex2) epsilon))) - -(defmacro assert-complex-equal (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'complex-equal)) - -;;; (NUMBER-EQUAL number1 number2) => true or false -(defun number-equal (number1 number2 &optional (epsilon *epsilon*)) - "Return true if the numbers are equal using the appropriate -comparison." - (cond - ((and (floatp number1) (floatp number2)) - (float-equal number1 number2 epsilon)) - ((and (typep number1 '(complex float)) (typep number2 '(complex float))) - (complex-equal number1 number2 epsilon)) - ((and (numberp number1) (numberp number2)) - (= number1 number2)) - (t (error "~A and ~A are not numbers." number1 number2)))) - -(defmacro assert-number-equal (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'number-equal)) - -;;; (NORMALIZE-FLOAT significand &optional exponent) => significand,exponent -(defun normalize-float (significand &optional (exponent 0)) - "Return the normalized floating point number and exponent." - (cond - ((zerop significand) - (values significand 0)) - ((>= (abs significand) 10) - (normalize-float (/ significand 10.0) (1+ exponent))) - ((< (abs significand) 1) - (normalize-float (* significand 10.0) (1- exponent))) - (t (values significand exponent)))) - -;;; (SIGFIG-EQUAL float1 float2 significant-figures) => true or false -(defun sigfig-equal (float1 float2 &optional (significant-figures *significant-figures*)) - "Return true if the floating point numbers have equal significant -figures." - ;; Convert 5 to precision of FLOAT1 and 10 to precision of FLOAT2. - ;; Then, rely on Rule of Float and Rational Contagion, CLHS 12.1.4.1, - ;; to obtain a DELTA of the proper precision. - (let ((delta (* (float 5 float1) (expt (float 10 float2) (- significant-figures))))) - (if (or (zerop float1) (zerop float2)) - (< (abs (+ float1 float2)) delta) - (multiple-value-bind (sig1 exp1) (normalize-float float1) - (multiple-value-bind (sig2 exp2) (normalize-float float2) - (and (= exp1 exp2) - (< (abs (- sig1 sig2)) delta))))))) - -(defmacro assert-sigfig-equal (significant-figures expected form &rest extras) - (expand-assert :equal form form expected extras - :test (lambda (f1 f2) (sigfig-equal f1 f2 significant-figures)))) - -;;; (ARRAY-EQUAL array1 array2) => true or false -(defun array-equal (array1 array2 &key (test #'number-equal)) - "Return true if the elements of the array are equal." - (when (equal (array-dimensions array1) (array-dimensions array2)) - (every test - (make-array (reduce #'* (array-dimensions array1)) :displaced-to array1) - (make-array (reduce #'* (array-dimensions array2)) :displaced-to array2)))) - -(defmacro assert-array-equal (element-test expected form &rest extras) - (expand-assert :equal form form expected extras - :test `(lambda (a1 a2) (array-equal a1 a2 :test ,element-test)))) - -;;; (NUMERICAL-EQUAL result1 result2) => true or false -;;; -;;; This is a universal wrapper created by Liam Healy. It is -;;; implemented to support testing in GSLL. The interface is expanded, -;;; but backwards compatible with previous versions. -;;; -(defun numerical-equal (result1 result2 &key (test #'number-equal)) - (cond - ((and (numberp result1) (numberp result2)) - (funcall test result1 result2)) - ((and (typep result1 'sequence) (typep result2 'sequence)) - (when (= (length result1) (length result2)) - (every (lambda (r1 r2) (numerical-equal r1 r2 :test test)) - result1 result2))) - ((and (arrayp result1) (arrayp result2)) - (array-equal result1 result2 :test test)) - (t (error "~A and/or ~A are not valid arguments." result1 result2)))) - -(defmacro assert-numerical-equal (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'numerical-equal)) diff --git a/test-unit/lisp-unit.lisp b/test-unit/lisp-unit.lisp deleted file mode 100644 index bf5aebfb5b4bbea44534784fb74e6ec7db26383d..0000000000000000000000000000000000000000 --- a/test-unit/lisp-unit.lisp +++ /dev/null @@ -1,429 +0,0 @@ -;;;-*- Mode: Lisp; Package: LISP-UNIT -*- - -#| -Copyright (c) 2004-2005 Christopher K. Riesbeck - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal in the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom the -Software is furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. -|# - - -;;; A test suite package, modelled after JUnit. -;;; Author: Chris Riesbeck -;;; -;;; Update history: -;;; -;;; 04/07/06 added ~<...~> to remaining error output forms [CKR] -;;; 04/06/06 added ~<...~> to compact error output better [CKR] -;;; 04/06/06 fixed RUN-TESTS to get tests dynamically (bug reported -;;; by Daniel Edward Burke) [CKR] -;;; 02/08/06 added newlines to error output [CKR] -;;; 12/30/05 renamed ASSERT-PREDICATE to ASSERT-EQUALITY [CKR] -;;; 12/29/05 added ASSERT-EQ, ASSERT-EQL, ASSERT-EQUALP [CKR] -;;; 12/22/05 recoded use-debugger to use handler-bind, added option to prompt for debugger, -;;; 11/07/05 added *use-debugger* and assert-predicate [DFB] -;;; 09/18/05 replaced Academic Free License with MIT Licence [CKR] -;;; 08/30/05 added license notice [CKR] -;;; 06/28/05 changed RUN-TESTS to compile code at run time, not expand time [CKR] -;;; 02/21/05 removed length check from SET-EQUAL [CKR] -;;; 02/17/05 added RUN-ALL-TESTS [CKR] -;;; 01/18/05 added ASSERT-EQUAL back in [CKR] -;;; 01/17/05 much clean up, added WITH-TEST-LISTENER [CKR] -;;; 01/15/05 replaced ASSERT-EQUAL etc. with ASSERT-TRUE and ASSERT-FALSE [CKR] -;;; 01/04/05 changed COLLECT-RESULTS to echo output on *STANDARD-OUTPuT* [CKR] -;;; 01/04/05 added optional package argument to REMOVE-ALL-TESTS [CKR] -;;; 01/04/05 changed OUTPUT-OK-P to trim spaces and returns [CKR] -;;; 01/04/05 changed OUTPUT-OK-P to not check output except when asked to [CKR] -;;; 12/03/04 merged REMOVE-TEST into REMOVE-TESTS [CKR] -;;; 12/03/04 removed ability to pass forms to RUN-TESTS [CKR] -;;; 12/03/04 refactored RUN-TESTS expansion into RUN-TEST-THUNKS [CKR] -;;; 12/02/04 changed to group tests under packages [CKR] -;;; 11/30/04 changed assertions to put expected value first, like JUnit [CKR] -;;; 11/30/04 improved error handling and summarization [CKR] -;;; 11/30/04 generalized RUN-TESTS, removed RUN-TEST [CKR] -;;; 02/27/04 fixed ASSERT-PRINTS not ignoring value [CKR] -;;; 02/07/04 fixed ASSERT-EXPANDS failure message [CKR] -;;; 02/07/04 added ASSERT-NULL, ASSERT-NOT-NULL [CKR] -;;; 01/31/04 added error handling and totalling to RUN-TESTS [CKR] -;;; 01/31/04 made RUN-TEST/RUN-TESTS macros [CKR] -;;; 01/29/04 fixed ASSERT-EXPANDS quote bug [CKR] -;;; 01/28/04 major changes from BUG-FINDER to be more like JUnit [CKR] - - -#| -How to use ----------- - -1. Read the documentation in lisp-unit.html. - -2. Make a file of DEFINE-TEST's. See exercise-tests.lisp for many -examples. If you want, start your test file with (REMOVE-TESTS) to -clear any previously defined tests. - -2. Load this file. - -2. (use-package :lisp-unit) - -3. Load your code file and your file of tests. - -4. Test your code with (RUN-TESTS test-name1 test-name2 ...) -- no quotes! -- -or simply (RUN-TESTS) to run all defined tests. - -A summary of how many tests passed and failed will be printed, -with details on the failures. - -Note: Nothing is compiled until RUN-TESTS is expanded. Redefining -functions or even macros does not require reloading any tests. - -For more information, see lisp-unit.html. - -|# - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Packages -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(cl:defpackage #:lisp-unit - (:use #:common-lisp) - (:export #:define-test #:run-all-tests #:run-tests - #:assert-eq #:assert-eql #:assert-equal #:assert-equalp - #:assert-error #:assert-expands #:assert-false - #:assert-equality #:assert-prints #:assert-true - #:get-test-code #:get-tests - #:remove-all-tests #:remove-tests - #:logically-equal #:set-equal - #:use-debugger - #:with-test-listener) - ) - -(in-package #:lisp-unit) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Globals -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defparameter *test-listener* nil) - -(defparameter *tests* (make-hash-table)) - -;;; Used by RUN-TESTS to collect summary statistics -(defvar *test-count* 0) -(defvar *pass-count* 0) - -;;; Set by RUN-TESTS for use by SHOW-FAILURE -(defvar *test-name* nil) - -;;; If nil, errors in tests are caught and counted. -;;; If :ask, user is given option of entering debugger or not. -;;; If true and not :ask, debugger is entered. -(defparameter *use-debugger* nil) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Macros -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; DEFINE-TEST - -(defmacro define-test (name &body body) - `(progn - (store-test-code ',name ',body) - ',name)) - -;;; ASSERT macros - -(defmacro assert-eq (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'eq)) - -(defmacro assert-eql (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'eql)) - -(defmacro assert-equal (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'equal)) - -(defmacro assert-equalp (expected form &rest extras) - (expand-assert :equal form form expected extras :test #'equalp)) - -(defmacro assert-error (condition form &rest extras) - (expand-assert :error form (expand-error-form form) - condition extras)) - -(defmacro assert-expands (&environment env expansion form &rest extras) - (expand-assert :macro form - (expand-macro-form form #+lispworks nil #-lispworks env) - expansion extras)) - -(defmacro assert-false (form &rest extras) - (expand-assert :result form form nil extras)) - -(defmacro assert-equality (test expected form &rest extras) - (expand-assert :equal form form expected extras :test test)) - -(defmacro assert-prints (output form &rest extras) - (expand-assert :output form (expand-output-form form) - output extras)) - -(defmacro assert-true (form &rest extras) - (expand-assert :result form form t extras)) - - -(defun expand-assert (type form body expected extras &key (test #'eql)) - `(internal-assert - ,type ',form #'(lambda () ,body) #'(lambda () ,expected) ,(expand-extras extras), test)) - -(defun expand-error-form (form) - `(handler-case ,form - (condition (error) error))) - -(defun expand-output-form (form) - (let ((out (gensym))) - `(let* ((,out (make-string-output-stream)) - (*standard-output* (make-broadcast-stream *standard-output* ,out))) - ,form - (get-output-stream-string ,out)))) - -(defun expand-macro-form (form env) - `(macroexpand-1 ',form ,env)) - -(defun expand-extras (extras) - `#'(lambda () - (list ,@(mapcan #'(lambda (form) (list `',form form)) extras)))) - - -;;; RUN-TESTS - -(defmacro run-all-tests (package &rest tests) - `(let ((*package* (find-package ',package))) - (run-tests - ,@(mapcar #'(lambda (test) (find-symbol (symbol-name test) package)) - tests)))) - -(defmacro run-tests (&rest names) - `(run-test-thunks (get-test-thunks ,(if (null names) '(get-tests *package*) `',names)))) - -(defun get-test-thunks (names &optional (package *package*)) - (mapcar #'(lambda (name) (get-test-thunk name package)) - names)) - -(defun get-test-thunk (name package) - (assert (get-test-code name package) (name package) - "No test defined for ~S in package ~S" name package) - (list name (coerce `(lambda () ,@(get-test-code name)) 'function))) - -(defun use-debugger (&optional (flag t)) - (setq *use-debugger* flag)) - -;;; WITH-TEST-LISTENER -(defmacro with-test-listener (listener &body body) - `(let ((*test-listener* #',listener)) ,@body)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Public functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun get-test-code (name &optional (package *package*)) - (let ((table (get-package-table package))) - (unless (null table) - (gethash name table)))) - -(defun get-tests (&optional (package *package*)) - (let ((l nil) - (table (get-package-table package))) - (cond ((null table) nil) - (t - (maphash #'(lambda (key val) - (declare (ignore val)) - (push key l)) - table) - (sort l #'string< :key #'string))))) - - -(defun remove-tests (names &optional (package *package*)) - (let ((table (get-package-table package))) - (unless (null table) - (if (null names) - (clrhash table) - (dolist (name names) - (remhash name table)))))) - -(defun remove-all-tests (&optional (package *package*)) - (if (null package) - (clrhash *tests*) - (remhash (find-package package) *tests*))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Private functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;; DEFINE-TEST support - -(defun get-package-table (package &key create) - (let ((table (gethash (find-package package) *tests*))) - (or table - (and create - (setf (gethash package *tests*) - (make-hash-table)))))) - -(defun get-test-name (form) - (if (atom form) form (cadr form))) - -(defun store-test-code (name code &optional (package *package*)) - (setf (gethash name - (get-package-table package :create t)) - code)) - - -;;; ASSERTION support - -(defun internal-assert (type form code-thunk expected-thunk extras test) - (let* ((expected (multiple-value-list (funcall expected-thunk))) - (actual (multiple-value-list (funcall code-thunk))) - (passed (test-passed-p type expected actual test))) - - (incf *test-count*) - (when passed - (incf *pass-count*)) - - (record-result passed type form expected actual extras) - - passed)) - -(defun record-result (passed type form expected actual extras) - (funcall (or *test-listener* 'default-listener) - passed type *test-name* form expected actual - (and extras (funcall extras)) - *test-count* *pass-count*)) - -(defun default-listener - (passed type name form expected actual extras test-count pass-count) - (declare (ignore test-count pass-count)) - (unless passed - (show-failure type (get-failure-message type) - name form expected actual extras))) - -(defun test-passed-p (type expected actual test) - (ecase type - (:error - (or (eql (car actual) (car expected)) - (typep (car actual) (car expected)))) - (:equal - (and (<= (length expected) (length actual)) - (every test expected actual))) - (:macro - (equal (car actual) (car expected))) - (:output - (string= (string-trim '(#\newline #\return #\space) - (car actual)) - (car expected))) - (:result - (logically-equal (car actual) (car expected))) - )) - - -;;; RUN-TESTS support - -(defun run-test-thunks (test-thunks) - (unless (null test-thunks) - (let ((total-test-count 0) - (total-pass-count 0) - (total-error-count 0)) - (dolist (test-thunk test-thunks) - (multiple-value-bind (test-count pass-count error-count) - (run-test-thunk (car test-thunk) (cadr test-thunk)) - (incf total-test-count test-count) - (incf total-pass-count pass-count) - (incf total-error-count error-count))) - (unless (null (cdr test-thunks)) - (show-summary 'total total-test-count total-pass-count total-error-count)) - (values)))) - -(defun run-test-thunk (*test-name* thunk) - (if (null thunk) - (format t "~& Test ~S not found" *test-name*) - (prog ((*test-count* 0) - (*pass-count* 0) - (error-count 0)) - (handler-bind - ((error #'(lambda (e) - (let ((*print-escape* nil)) - (setq error-count 1) - (format t "~& ~S: ~W" *test-name* e)) - (if (use-debugger-p e) e (go exit))))) - (funcall thunk) - (show-summary *test-name* *test-count* *pass-count*)) - exit - (return (values *test-count* *pass-count* error-count))))) - -(defun use-debugger-p (e) - (and *use-debugger* - (or (not (eql *use-debugger* :ask)) - (y-or-n-p "~A -- debug?" e)))) - -;;; OUTPUT support - -(defun get-failure-message (type) - (case type - (:error "~&~@[Should have signalled ~{~S~^; ~} but saw~] ~{~S~^; ~}") - (:macro "~&Should have expanded to ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>") - (:output "~&Should have printed ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>") - (t "~&Expected ~{~S~^; ~} ~<~%~:;but saw ~{~S~^; ~}~>") - )) - -(defun show-failure (type msg name form expected actual extras) - (format t "~&~@[~S: ~]~S failed: " name form) - (format t msg expected actual) - (format t "~{~& ~S => ~S~}~%" extras) - type) - -(defun show-summary (name test-count pass-count &optional error-count) - (format t "~&~A: ~S assertions passed, ~S failed~@[, ~S execution errors~]." - name pass-count (- test-count pass-count) error-count)) - -(defun collect-form-values (form values) - (mapcan #'(lambda (form-arg value) - (if (constantp form-arg) - nil - (list form-arg value))) - (cdr form) - values)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Useful equality predicates for tests -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; (LOGICALLY-EQUAL x y) => true or false -;;; Return true if x and y both false or both true - -(defun logically-equal (x y) - (eql (not x) (not y))) - -;;; (SET-EQUAL l1 l2 :test) => true or false -;;; Return true if every element of l1 is an element of l2 -;;; and vice versa. - -(defun set-equal (l1 l2 &key (test #'equal)) - (and (listp l1) - (listp l2) - (subsetp l1 l2 :test test) - (subsetp l2 l1 :test test))) - - -(provide "lisp-unit")