diff --git a/ansi-tests/etypecase.lsp b/ansi-tests/etypecase.lsp index 7880e18dc48174f7e51f1003070fe0a7e3af8138..1c2121691ab1ca1b5a8f1cfc1def36ef1a9e9f5c 100644 --- a/ansi-tests/etypecase.lsp +++ b/ansi-tests/etypecase.lsp @@ -5,6 +5,8 @@ (in-package :cl-test) +(compile-and-load "types-aux.lsp") + (deftest etypecase.1 (etypecase 1 (integer 'a) (t 'b)) a) @@ -70,6 +72,45 @@ (return 'good))) good) +(deftest etypecase.14 + (loop + for x in '(1 a 1.3 "") + collect + (etypecase x (t :good) (integer :bad) (symbol :bad) + (float :bad) (string :bad))) + (:good :good :good :good)) + +(deftest etypecase.15 + (let* ((u (coerce *universe* 'vector)) + (len1 (length u)) + (types (coerce *cl-all-type-symbols* 'vector)) + (len2 (length types))) + (loop + for n = (random 10) + for my-types = (loop repeat n collect (elt types (random len2))) + for val = (elt u (random len1)) + for i = (position val my-types :test #'typep) + for form = `(function + (lambda (x) + (handler-case + (etypecase x + ,@(loop for i from 0 for type in my-types collect `(,type ,i))) + (type-error (c) + (assert (eql x (type-error-datum c))) + (let* ((expected (type-error-expected-type c))) + (let ((equiv (check-equivalence expected + ',(cons 'or my-types)))) + (assert (null equiv) () "EQUIV = ~A" EQUIV))) + nil)))) + for j = (funcall (eval form) val) + repeat 200 + unless (eql i j) + collect (list n my-types val i form j))) + nil) + + +;;; Error cases + (deftest etypecase.error.1 (signals-error (funcall (macro-function 'etypecase)) program-error)