Commit cc55a33e authored by pfdietz's avatar pfdietz

Added tests for TYPECASE, ETYPECASE, and CTYPECASE.

parent 4fc90271
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Oct 18 23:05:10 2002
;;;; Contains: Tests of CTYPECASE
(in-package :cl-test)
(deftest ctypecase.1
(let ((x 1))
(ctypecase x (integer 'a) (t 'b)))
a)
(deftest ctypecase.2
(let ((x 1))
(classify-error (ctypecase x (symbol 'a))))
type-error)
(deftest ctypecase.3
(let ((x 1))
(ctypecase x (symbol 'a) (t 'b)))
b)
(deftest ctypecase.4
(let ((x 1))
(ctypecase x (t (values)))))
(deftest ctypecase.5
(let ((x 1))
(ctypecase x (integer (values)) (t 'a))))
(deftest ctypecase.6
(let ((x 1))
(ctypecase x (bit 'a) (integer 'b)))
a)
(deftest ctypecase.7
(let ((x 1))
(ctypecase x (t 'a)))
a)
(deftest ctypecase.8
(let ((x 1))
(ctypecase x (t (values 'a 'b 'c))))
a b c)
(deftest ctypecase.9
(let ((x 1))
(ctypecase x (integer (values 'a 'b 'c)) (t nil)))
a b c)
(deftest ctypecase.10
(let ((x 0) (y 1))
(values
(ctypecase y
(bit (incf x) 'a)
(integer (incf x 2) 'b)
(t (incf x 4) 'c))
x))
a 1)
(deftest ctypecase.11
(let ((x 1))
(ctypecase x (integer) (t 'a)))
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Oct 18 23:02:23 2002
;;;; Contains: Tests of ETYPECASE
(in-package :cl-test)
(deftest etypecase.1
(etypecase 1 (integer 'a) (t 'b))
a)
(deftest etypecase.2
(classify-error (etypecase 1 (symbol 'a)))
type-error)
(deftest etypecase.3
(etypecase 1 (symbol 'a) (t 'b))
b)
(deftest etypecase.4
(etypecase 1 (t (values))))
(deftest etypecase.5
(etypecase 1 (integer (values)) (t 'a)))
(deftest etypecase.6
(etypecase 1 (bit 'a) (integer 'b))
a)
(deftest etypecase.7
(etypecase 1 (t 'a))
a)
(deftest etypecase.8
(etypecase 1 (t (values 'a 'b 'c)))
a b c)
(deftest etypecase.9
(etypecase 1 (integer (values 'a 'b 'c)) (t nil))
a b c)
(deftest etypecase.10
(let ((x 0))
(values
(etypecase 1
(bit (incf x) 'a)
(integer (incf x 2) 'b)
(t (incf x 4) 'c))
x))
a 1)
(deftest etypecase.11
(etypecase 1 (integer) (t 'a))
nil)
......@@ -20,6 +20,7 @@
(load "constantly.lsp")
(load "complement.lsp")
(load "cond.lsp")
(load "ctypecase.lsp")
(load "defconstant.lsp")
(load "defparameter.lsp")
(load "defvar.lsp")
......@@ -28,6 +29,7 @@
(load "equal.lsp")
(load "equalp.lsp")
(load "eql.lsp")
(load "etypecase.lsp")
(load "every.lsp")
(load "fboundp.lsp")
(load "flet.lsp")
......@@ -51,6 +53,7 @@
(load "some.lsp")
(load "t.lsp")
(load "tagbody.lsp")
(load "typecase.lsp")
(load "unless.lsp")
(load "unwind-protect.lsp")
(load "when.lsp")
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Oct 18 22:51:25 2002
;;;; Contains: Tests for TYPECASE
(in-package :cl-test)
(deftest typecase.1
(typecase 1 (integer 'a) (t 'b))
a)
(deftest typecase.2
(typecase 1 (symbol 'a))
nil)
(deftest typecase.3
(typecase 1 (symbol 'a) (t 'b))
b)
(deftest typecase.4
(typecase 1 (t (values))))
(deftest typecase.5
(typecase 1 (integer (values)) (t 'a)))
(deftest typecase.6
(typecase 1 (bit 'a) (integer 'b))
a)
(deftest typecase.7
(typecase 1 (otherwise 'a))
a)
(deftest typecase.8
(typecase 1 (t (values 'a 'b 'c)))
a b c)
(deftest typecase.9
(typecase 1 (integer (values 'a 'b 'c)) (t nil))
a b c)
(deftest typecase.10
(let ((x 0))
(values
(typecase 1
(bit (incf x) 'a)
(integer (incf x 2) 'b)
(t (incf x 4) 'c))
x))
a 1)
(deftest typecase.11
(typecase 1 (otherwise 'a))
a)
(deftest typecase.12
(typecase 1 (integer) (t 'a))
nil)
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