lisp-unit.lisp

   1 ;;;-*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 #|
   4 Copyright (c) 2004-2005 Christopher K. Riesbeck
   5
   6 Permission is hereby granted, free of charge, to any person obtaining
   7 a copy of this software and associated documentation files (the "Software"),
   8 to deal in the Software without restriction, including without limitation
   9 the rights to use, copy, modify, merge, publish, distribute, sublicense,
  10 and/or sell copies of the Software, and to permit persons to whom the
  11 Software is furnished to do so, subject to the following conditions:
  12
  13 The above copyright notice and this permission notice shall be included
  14 in all copies or substantial portions of the Software.
  15
  16 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
  17 OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
  19 THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
  20 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
  21 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  22 OTHER DEALINGS IN THE SOFTWARE.
  23
  24
  25 How to use
  26 ----------
  27
  28 1. Read the documentation at:
  29    https://github.com/OdonataResearchLLC/lisp-unit/wiki
  30
  31 2. Make a file of DEFINE-TEST's. See exercise-tests.lisp for many
  32 examples. If you want, start your test file with (REMOVE-TESTS :ALL)
  33 to clear any previously defined tests.
  34
  35 3. Load this file.
  36
  37 4. (use-package :lisp-unit)
  38
  39 5. Load your code file and your file of tests.
  40
  41 6. Test your code with (RUN-TESTS '(test-name1 test-name2 ...)) or
  42 simply (RUN-TESTS :ALL) to run all defined tests.
  43
  44 A summary of how many tests passed and failed will be printed.
  45
  46 NOTE: Nothing is compiled until RUN-TESTS is expanded. Redefining
  47 functions or even macros does not require reloading any tests.
  48
  49 |#
  50
  51 ;;; Packages
  52
  53 (in-package :cl-user)
  54
  55 (defpackage :lisp-unit
  56   (:use :common-lisp)
  57   ;; Print parameters
  58   (:export :*print-summary*
  59            :*print-failures*
  60            :*print-errors*)
  61   ;; Forms for assertions
  62   (:export :assert-eq
  63            :assert-eql
  64            :assert-equal
  65            :assert-equalp
  66            :assert-equality
  67            :assert-prints
  68            :assert-expands
  69            :assert-true
  70            :assert-false
  71            :assert-error)
  72   ;; Functions for managing tests
  73   (:export :define-test
  74            :list-tests
  75            :test-code
  76            :test-documentation
  77            :remove-tests
  78            :run-tests
  79            :use-debugger)
  80   ;; Functions for managing tags
  81   (:export :list-tags
  82            :tagged-tests
  83            :remove-tags
  84            :run-tags)
  85   ;; Functions for reporting test results
  86   (:export :test-names
  87            :failed-tests
  88            :error-tests
  89            :missing-tests
  90            :summarize-results)
  91   ;; Utility predicates
  92   (:export :logically-equal :set-equal))
  93
  94 (in-package :lisp-unit)
  95
  96 ;;; Global counters
  97
  98 (defparameter *pass* ()
  99   "The passed assertion results.")
 100
 101 (defparameter *fail* ()
 102   "The failed assertion results.")
 103
 104 ;;; Global options
 105
 106 (defparameter *print-summary* nil
 107   "Print a summary of the pass, fail, and error count if non-nil.")
 108
 109 (defparameter *print-failures* nil
 110   "Print failure messages if non-NIL.")
 111
 112 (defparameter *print-errors* nil
 113   "Print error messages if non-NIL.")
 114
 115 (defparameter *use-debugger* nil
 116   "If not NIL, enter the debugger when an error is encountered in an
 117 assertion.")
 118
 119 (defun use-debugger-p (condition)
 120   "Debug or ignore errors."
 121   (cond
 122    ((eq :ask *use-debugger*)
 123     (y-or-n-p "~A -- debug?" condition))
 124    (*use-debugger*)))
 125
 126 ;;; Global unit test database
 127
 128 (defparameter *test-db* (make-hash-table :test #'eq)
 129   "The unit test database is simply a hash table.")
 130
 131 (defun package-table (package &optional create)
 132   (cond
 133    ((gethash (find-package package) *test-db*))
 134    (create
 135     (setf (gethash package *test-db*) (make-hash-table)))
 136    (t (warn "No tests defined for package: ~S" package))))
 137
 138 ;;; Global tags database
 139
 140 (defparameter *tag-db* (make-hash-table :test #'eq)
 141   "The tag database is simply a hash table.")
 142
 143 (defun package-tags (package &optional create)
 144   "Return the tags DB for the package."
 145   (cond
 146    ((gethash (find-package package) *tag-db*))
 147    (create
 148     (setf (gethash package *tag-db*) (make-hash-table)))
 149    (t (warn "No tags defined for package: ~S" package))))
 150
 151 ;;; Unit test definition
 152
 153 (defclass unit-test ()
 154   ((doc
 155     :type string
 156     :initarg :doc
 157     :reader doc)
 158    (code
 159     :type list
 160     :initarg :code
 161     :reader code))
 162   (:default-initargs :doc "" :code ())
 163   (:documentation
 164    "Organize the unit test documentation and code."))
 165
 166 ;;; NOTE: Shamelessly taken from PG's analyze-body
 167 (defun parse-body (body &optional doc tag)
 168   "Separate the components of the body."
 169   (let ((item (first body)))
 170     (cond
 171      ((and (listp item) (eq :tag (first item)))
 172       (parse-body (rest body) doc (nconc (rest item) tag)))
 173      ((and (stringp item) (not doc) (rest body))
 174       (if tag
 175           (values doc tag (rest body))
 176           (parse-body (rest body) doc tag)))
 177      (t (values doc tag body)))))
 178
 179 (defmacro define-test (name &body body)
 180   "Store the test in the test database."
 181   (multiple-value-bind (doc tag code) (parse-body body)
 182     `(let ((doc (or ,doc (string ',name))))
 183        (setf
 184         ;; Unit test
 185         (gethash ',name (package-table *package* t))
 186         (make-instance 'unit-test :doc doc :code ',code))
 187        ;; Tags
 188        (loop for tag in ',tag do
 189              (pushnew
 190               ',name (gethash tag (package-tags *package* t))))
 191        ;; Return the name of the test
 192        ',name)))
 193
 194 ;;; Manage tests
 195
 196 (defun list-tests (&optional (package *package*))
 197   "Return a list of the tests in package."
 198   (let ((table (package-table package)))
 199     (when table
 200       (loop for test-name being each hash-key in table
 201             collect test-name))))
 202
 203 (defun test-documentation (name &optional (package *package*))
 204   "Return the documentation for the test."
 205   (let ((unit-test (gethash name (package-table package))))
 206     (if (null unit-test)
 207         (warn "No code defined for test ~A in package ~S."
 208               name package)
 209         (doc unit-test))))
 210
 211 (defun test-code (name &optional (package *package*))
 212   "Returns the code stored for the test name."
 213   (let ((unit-test (gethash name (package-table package))))
 214     (if (null unit-test)
 215         (warn "No code defined for test ~A in package ~S."
 216               name package)
 217         (code unit-test))))
 218
 219 (defun remove-tests (names &optional (package *package*))
 220   "Remove individual tests or entire sets."
 221   (if (eq :all names)
 222       (if (null package)
 223           (clrhash *test-db*)
 224           (progn
 225             (remhash (find-package package) *test-db*)
 226             (remhash (find-package package) *tag-db*)))
 227       (let ((table (package-table package)))
 228         (unless (null table)
 229           ;; Remove tests
 230           (loop for name in names
 231                 always (remhash name table)
 232                 collect name into removed
 233                 finally (return removed))
 234           ;; Remove tests from tags
 235           (loop with tags = (package-tags package)
 236                 for tag being each hash-key in tags
 237                 using (hash-value tagged-tests)
 238                 do
 239                 (setf
 240                  (gethash tag tags)
 241                  (set-difference tagged-tests names)))))))
 242
 243 ;;; Manage tags
 244
 245 (defun %tests-from-all-tags (&optional (package *package*))
 246   "Return all of the tests that have been tagged."
 247   (loop for tests being each hash-value in (package-tags package)
 248         nconc (copy-list tests) into all-tests
 249         finally (return (delete-duplicates all-tests))))
 250
 251 (defun %tests-from-tags (tags &optional (package *package*))
 252   "Return the tests associated with the tags."
 253   (loop with table = (package-tags package)
 254         for tag in tags
 255         as tests = (gethash tag table)
 256         nconc (copy-list tests) into all-tests
 257         finally (return (delete-duplicates all-tests))))
 258
 259 (defun list-tags (&optional (package *package*))
 260   "Return a list of the tags in package."
 261   (let ((tags (package-tags package)))
 262     (when tags
 263       (loop for tag being each hash-key in tags collect tag))))
 264
 265 (defun tagged-tests (tags &optional (package *package*))
 266   "Run the tests associated with the specified tags in package."
 267   (if (eq :all tags)
 268       (%tests-from-all-tags package)
 269       (%tests-from-tags tags package)))
 270
 271 (defun remove-tags (tags &optional (package *package*))
 272   "Remove individual tags or entire sets."
 273   (if (eq :all tags)
 274       (if (null package)
 275           (clrhash *tag-db*)
 276           (remhash (find-package package) *tag-db*))
 277       (let ((table (package-tags package)))
 278         (unless (null table)
 279           (loop for tag in tags
 280                 always (remhash tag table)
 281                 collect tag into removed
 282                 finally (return removed))))))
 283
 284 ;;; Assert macros
 285
 286 (defmacro assert-eq (expected form &rest extras)
 287   "Assert whether expected and form are EQ."
 288   `(expand-assert :equal ,form ,form ,expected ,extras :test #'eq))
 289
 290 (defmacro assert-eql (expected form &rest extras)
 291   "Assert whether expected and form are EQL."
 292   `(expand-assert :equal ,form ,form ,expected ,extras :test #'eql))
 293
 294 (defmacro assert-equal (expected form &rest extras)
 295   "Assert whether expected and form are EQUAL."
 296   `(expand-assert :equal ,form ,form ,expected ,extras :test #'equal))
 297
 298 (defmacro assert-equalp (expected form &rest extras)
 299   "Assert whether expected and form are EQUALP."
 300   `(expand-assert :equal ,form ,form ,expected ,extras :test #'equalp))
 301
 302 (defmacro assert-error (condition form &rest extras)
 303   "Assert whether form signals condition."
 304   `(expand-assert :error ,form (expand-error-form ,form)
 305                   ,condition ,extras))
 306
 307 (defmacro assert-expands (expansion form &rest extras)
 308   "Assert whether form expands to expansion."
 309   `(expand-assert :macro ,form
 310                   (expand-macro-form ,form nil)
 311                   ,expansion ,extras))
 312
 313 (defmacro assert-false (form &rest extras)
 314   "Assert whether the form is false."
 315   `(expand-assert :result ,form ,form nil ,extras))
 316
 317 (defmacro assert-equality (test expected form &rest extras)
 318   "Assert whether expected and form are equal according to test."
 319   `(expand-assert :equal ,form ,form ,expected ,extras :test ,test))
 320
 321 (defmacro assert-prints (output form &rest extras)
 322   "Assert whether printing the form generates the output."
 323   `(expand-assert :output ,form (expand-output-form ,form)
 324                   ,output ,extras))
 325
 326 (defmacro assert-true (form &rest extras)
 327   "Assert whether the form is true."
 328   `(expand-assert :result ,form ,form t ,extras))
 329
 330 (defmacro expand-assert (type form body expected extras &key (test '#'eql))
 331   "Expand the assertion to the internal format."
 332   `(internal-assert ,type ',form
 333                     (lambda () ,body)
 334                     (lambda () ,expected)
 335                     (expand-extras ,extras)
 336                     ,test))
 337
 338 (defmacro expand-error-form (form)
 339   "Wrap the error assertion in HANDLER-CASE."
 340   `(handler-case ,form
 341      (condition (error) error)))
 342
 343 (defmacro expand-output-form (form)
 344   "Capture the output of the form in a string."
 345   (let ((out (gensym)))
 346     `(let* ((,out (make-string-output-stream))
 347             (*standard-output*
 348              (make-broadcast-stream *standard-output* ,out)))
 349        ,form
 350        (get-output-stream-string ,out))))
 351
 352 (defmacro expand-macro-form (form env)
 353   "Expand the macro form once."
 354   `(macroexpand-1 ',form ,env))
 355
 356 (defmacro expand-extras (extras)
 357   "Expand extra forms."
 358   `(lambda ()
 359      (list ,@(mapcan (lambda (form) (list `',form form)) extras))))
 360
 361 (defclass assert-result ()
 362   ((form
 363     :initarg :form
 364     :reader form)
 365    (actual
 366     :type list
 367     :initarg :actual
 368     :reader actual)
 369    (expected
 370     :type list
 371     :initarg :expected
 372     :reader expected)
 373    (extras
 374     :type list
 375     :initarg :extras
 376     :reader extras)
 377    (test
 378     :type function
 379     :initarg :test
 380     :reader test)
 381    (passed
 382     :type boolean
 383     :reader passed))
 384   (:documentation
 385    "Result of the assertion."))
 386
 387 (defmethod initialize-instance :after ((self assert-result)
 388                                        &rest initargs)
 389   "Evaluate the actual and expected forms"
 390   (with-slots (actual expected) self
 391     (setf
 392      actual (multiple-value-list (funcall actual))
 393      expected (multiple-value-list (funcall expected)))))
 394
 395 (defclass equal-result (assert-result)
 396   ()
 397   (:documentation
 398    "Result of an equal assertion type."))
 399
 400 (defmethod initialize-instance :after ((self equal-result)
 401                                        &rest initargs)
 402   "Return the result of the equality assertion."
 403   (with-slots (actual expected test passed) self
 404     (setf
 405      passed
 406      (and
 407       (<= (length expected) (length actual))
 408       (every test expected actual)))))
 409
 410 (defclass error-result (assert-result)
 411   ()
 412   (:documentation
 413    "Result of an error assertion type."))
 414
 415 (defmethod initialize-instance :after ((self error-result)
 416                                        &rest initargs)
 417   "Evaluate the result."
 418   (with-slots (actual expected passed) self
 419     (setf
 420      passed
 421      (or
 422       (eql (car actual) (car expected))
 423       (typep (car actual) (car expected))))))
 424
 425 (defclass macro-result (assert-result)
 426   ()
 427   (:documentation
 428    "Result of a macro assertion type."))
 429
 430 (defmethod initialize-instance :after ((self macro-result)
 431                                        &rest initargs)
 432   "Return the result of the macro expansion."
 433   (with-slots (actual expected passed) self
 434     (setf passed (equal (car actual) (car expected)))))
 435
 436 (defclass boolean-result (assert-result)
 437   ()
 438   (:documentation
 439    "Result of a result assertion type."))
 440
 441 (defmethod initialize-instance :after ((self boolean-result)
 442                                        &rest initargs)
 443   "Return the result of the assertion."
 444   (with-slots (actual expected passed) self
 445     (setf passed (logically-equal (car actual) (car expected)))))
 446
 447 (defclass output-result (assert-result)
 448   ()
 449   (:documentation
 450    "Result of an output assertion type."))
 451
 452 (defmethod initialize-instance :after ((self output-result)
 453                                        &rest initargs)
 454   "Return the result of the printed output."
 455   (with-slots (actual expected passed) self
 456     (setf
 457      passed
 458      (string=
 459       (string-trim '(#\newline #\return #\space) (car actual))
 460       (car expected)))))
 461
 462 (defun assert-class (type)
 463   "Return the class name for the assertion type."
 464   (ecase type
 465     (:equal 'equal-result)
 466     (:error 'error-result)
 467     (:macro 'macro-result)
 468     (:result 'boolean-result)
 469     (:output 'output-result)))
 470
 471 (defun internal-assert
 472        (type form code-thunk expected-thunk extras test)
 473   "Perform the assertion and record the results."
 474   (let ((result
 475          (make-instance (assert-class type)
 476                         :form form
 477                         :actual code-thunk
 478                         :expected expected-thunk
 479                         :extras extras
 480                         :test test)))
 481     (if (passed result)
 482         (push result *pass*)
 483         (push result *fail*))
 484     ;; Return the result
 485     (passed result)))
 486
 487 ;;; Unit test results
 488
 489 (defclass test-result ()
 490   ((name
 491     :type symbol
 492     :initarg :name
 493     :reader name)
 494    (pass
 495     :type list
 496     :initarg :pass
 497     :reader pass)
 498    (fail
 499     :type list
 500     :initarg :fail
 501     :reader fail)
 502    (exerr
 503     :type condition
 504     :initarg :exerr
 505     :reader exerr))
 506   (:default-initargs :exerr nil)
 507   (:documentation
 508    "Store the results of the unit test."))
 509
 510 (defun print-summary (test-result)
 511   "Print a summary of the test result."
 512   (format t "~&~A: ~S assertions passed, ~S failed"
 513           (name test-result)
 514           (length (pass test-result))
 515           (length (fail test-result)))
 516   (format t "~@[, ~S execution errors~].~2%"
 517           (exerr test-result)))
 518
 519 (defun run-code (code)
 520   "Run the code to test the assertions."
 521   (funcall (coerce `(lambda () ,@code) 'function)))
 522
 523 (defun run-test-thunk (name code)
 524   (let ((*pass* ())
 525         (*fail* ()))
 526     (handler-bind
 527         ((error
 528           (lambda (condition)
 529             (if (use-debugger-p condition)
 530                 condition
 531                 (return-from run-test-thunk
 532                   (make-instance
 533                    'test-result
 534                    :name name
 535                    :pass *pass*
 536                    :fail *fail*
 537                    :exerr condition))))))
 538       (run-code code))
 539     ;; Return the result count
 540     (make-instance 'test-result
 541                    :name name
 542                    :pass *pass*
 543                    :fail *fail*)))
 544
 545 ;;; Test results database
 546
 547 (defclass test-results-db ()
 548   ((database
 549     :type hash-table
 550     :initform (make-hash-table :test #'eq)
 551     :reader database)
 552    (pass
 553     :type fixnum
 554     :initform 0
 555     :accessor pass)
 556    (fail
 557     :type fixnum
 558     :initform 0
 559     :accessor fail)
 560    (exerr
 561     :type fixnum
 562     :initform 0
 563     :accessor exerr)
 564    (failed-tests
 565     :type list
 566     :initform ()
 567     :accessor failed-tests)
 568    (error-tests
 569     :type list
 570     :initform ()
 571     :accessor error-tests)
 572    (missing-tests
 573     :type list
 574     :initform ()
 575     :accessor missing-tests))
 576   (:documentation
 577    "Store the results of the tests for further evaluation."))
 578
 579 (defmethod print-object ((object test-results-db) stream)
 580   "Print the summary counts with the object."
 581   (let ((pass (pass object))
 582         (fail (fail object))
 583         (exerr (exerr object)))
 584     (format
 585      stream "#<~A Total(~D) Passed(~D) Failed(~D) Errors(~D)>~%"
 586      (class-name (class-of object))
 587      (+ pass fail) pass fail exerr)))
 588
 589 (defun test-names (test-results-db)
 590   "Return a list of the test names in the database."
 591   (loop for name being each hash-key in (database test-results-db)
 592         collect name))
 593
 594 (defun record-result (test-name code results)
 595   "Run the test code and record the result."
 596   (let ((result (run-test-thunk test-name code)))
 597     ;; Store the result
 598     (setf (gethash test-name (database results)) result)
 599     ;; Count passed tests
 600     (when (pass result)
 601       (incf (pass results) (length (pass result))))
 602     ;; Count failed tests and record the name
 603     (when (fail result)
 604       (incf (fail results) (length (fail result)))
 605       (push test-name (failed-tests results)))
 606     ;; Count errors and record the name
 607     (when (exerr result)
 608       (incf (exerr results))
 609       (push test-name (error-tests results)))))
 610
 611 (defun summarize-results (results)
 612   "Print a summary of all results."
 613   (let ((pass (pass results))
 614         (fail (fail results)))
 615     (format t "~&Unit Test Summary~%")
 616     (format t " | ~D assertions total~%" (+ pass fail))
 617     (format t " | ~D passed~%" pass)
 618     (format t " | ~D failed~%" fail)
 619     (format t " | ~D execution errors~%" (exerr results))
 620     (format t " | ~D missing tests~2%"
 621             (length (missing-tests results)))))
 622
 623 ;;; Run the tests
 624
 625 (defun %run-all-thunks (&optional (package *package*))
 626   "Run all of the test thunks in the package."
 627   (loop
 628    with results = (make-instance 'test-results-db)
 629    for test-name being each hash-key in (package-table package)
 630    using (hash-value unit-test)
 631    if unit-test do
 632    (record-result test-name (code unit-test) results)
 633    else do
 634    (push test-name (missing-tests results))
 635    ;; Summarize and return the test results
 636    finally
 637    (summarize-results results)
 638    (return results)))
 639
 640 (defun %run-thunks (test-names &optional (package *package*))
 641   "Run the list of test thunks in the package."
 642   (loop
 643    with table = (package-table package)
 644    and results = (make-instance 'test-results)
 645    for test-name in test-names
 646    as unit-test = (gethash test-name table)
 647    if unit-test do
 648    (record-result test-name (code unit-test) results)
 649    else do
 650    (push test-name (missing-tests results))
 651    finally
 652    (summarize-results results)
 653    (return results)))
 654
 655 (defun run-tests (test-names &optional (package *package*))
 656   "Run the specified tests in package."
 657   (if (eq :all test-names)
 658       (%run-all-thunks package)
 659       (%run-thunks test-names package)))
 660
 661 (defun run-tags (tags &optional (package *package*))
 662   "Run the tests associated with the specified tags in package."
 663   (%run-thunks (tagged-tests tags package) package))
 664
 665 ;;; Print failures
 666
 667 (defgeneric print-failure (result)
 668   (:documentation
 669    "Report the results of the failed assertion."))
 670
 671 (defmethod print-failure :around ((result assert-result))
 672   "Failure header and footer output."
 673   (format t "~& | Failed Form: ~S" (form result))
 674   (call-next-method)
 675   (when (extras result)
 676     (format t "~{~& | ~S => ~S~}~%"
 677             (funcall (extras result))))
 678   (format t "~& |~%")
 679   (class-name result))
 680
 681 (defmethod print-failure ((result assert-result))
 682   (format t "~& | Expected ~{~S~^; ~} " (expected result))
 683   (format t "~<~% | ~:;but saw ~{~S~^; ~}~>" (actual result)))
 684
 685 (defmethod print-failure ((result error-result))
 686   (format t "~& | ~@[Should have signalled ~{~S~^; ~} but saw~]"
 687           (expected result))
 688   (format t " ~{~S~^; ~}" (actual result)))
 689
 690 (defmethod print-failure ((result macro-result))
 691   (format t "~& | Should have expanded to ~{~S~^; ~} "
 692           (expected result))
 693   (format t "~<~%~:;but saw ~{~S~^; ~}~>" (actual result)))
 694
 695 (defmethod print-failure ((result output-result))
 696   (format t "~& | Should have printed ~{~S~^; ~} "
 697           (expected result))
 698   (format t "~<~%~:;but saw ~{~S~^; ~}~>"
 699           (actual result)))
 700
 701 ;;; Print errors
 702
 703 (defgeneric print-error (result)
 704   (:documentation
 705    "Print the error condition."))
 706
 707 (defmethod print-error ((result test-result))
 708   "Print the error condition."
 709   (let ((*print-escape* nil))
 710     (format t "~& | Execution error:~% | ~W" (condition result))
 711     (format t "~& |~%")
 712     (print-summary result)))
 713
 714 ;;; Useful equality predicates for tests
 715
 716 ;;; (LOGICALLY-EQUAL x y) => true or false
 717 ;;;   Return true if x and y both false or both true
 718 (defun logically-equal (x y)
 719   (eql (not x) (not y)))
 720
 721 ;;; (SET-EQUAL l1 l2 :test) => true or false
 722 ;;;   Return true if every element of l1 is an element of l2
 723 ;;;   and vice versa.
 724 (defun set-equal (l1 l2 &key (test #'equal))
 725   (and (listp l1)
 726        (listp l2)
 727        (subsetp l1 l2 :test test)
 728        (subsetp l2 l1 :test test)))
 729
 730 (pushnew :lisp-unit common-lisp:*features*)