Commit 53c82f2d authored by pfdietz's avatar pfdietz
Browse files

Added more tests for BLOCK, tests for CATCH & THROW.

parent b1f281e8
......@@ -84,7 +84,9 @@ the condition to go uncaught if it cannot be classified."
(handler-case ,form
(undefined-function () 'undefined-function)
(program-error () 'program-error)
(type-error () 'type-error))))
(type-error () 'type-error)
(control-error () 'control-error)
)))
;;;
;;; A scaffold is a structure that is used to remember the object
......
......@@ -38,5 +38,28 @@
'bad)
good)
(deftest block.6
(block b1
(return-from b1 (values))
1))
(deftest block.7
(block b1
(return-from b1 (values 1 2 3 4))
1)
1 2 3 4)
(deftest block.8
(block foo)
nil)
(deftest block.9
(block foo (values 'a 'b) (values 'c 'd))
c d)
(deftest block.10
(block done
(flet ((%f (x) (return-from done x)))
(block done (mapcar #'%f '(good bad bad))))
'bad)
good)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Oct 12 13:04:02 2002
;;;; Contains: Tests of CATCH and THROW
(in-package :cl-test)
(deftest catch.1
(catch 'foo)
nil)
(deftest catch.2
(catch 'foo 'a)
a)
(deftest catch.3
(catch 'foo (values)))
(deftest catch.4
(catch 'foo (values 1 2 3))
1 2 3)
(deftest catch.5
(catch 'foo 'a (throw 'foo 'b) 'c)
b)
(deftest catch.6
(let ((tag1 (1+ most-positive-fixnum))
(tag2 (1+ most-positive-fixnum)))
(if (eq tag1 tag2)
'good
(catch tag1
(catch tag2 (throw tag1 'good))
'bad)))
good)
(deftest catch.7
(catch 'foo 'a (throw 'foo (values)) 'c))
(deftest catch.8
(catch 'foo 'a (throw 'foo (values 1 2 3)) 'c)
1 2 3)
(deftest catch.9
(let ((i 0))
(catch (progn (incf i) 'foo)
(assert (eql i 1))
(throw (progn (incf i 2) 'foo) i)))
3)
(deftest catch.10
(flet ((%f (x) (throw 'foo x)))
(catch 'foo
(%f 'good)
'bad))
good)
(defun catch.11-fn (x) (throw 'foo x))
(deftest catch.11
(catch 'foo
(catch.11-fn 'good)
'bad)
good)
(deftest catch.12
(labels ((%f (x) (throw 'foo x)))
(catch 'foo
(%f 'good)
'bad))
good)
(deftest throw-error
(classify-error (throw (gensym) nil))
control-error)
......@@ -11,6 +11,7 @@
(load "places.lsp")
(load "block.lsp")
(load "call-arguments-limit.lsp")
(load "catch.lsp")
(load "constantly.lsp")
(load "complement.lsp")
(load "defconstant.lsp")
......
Supports Markdown
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