Commit 2235522e authored by pfdietz's avatar pfdietz

Add randomized tests for typecase, etypecase.

parent 0775e415
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment