Skip to content
Snippets Groups Projects
Commit 2235522e authored by pfdietz's avatar pfdietz
Browse files

Add randomized tests for typecase, etypecase.

parent 0775e415
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment