From a9fc854e2118836ec06f83c62be7d7ad8796c639 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 12 Oct 2002 21:03:42 +0000 Subject: [PATCH] Added tests for UNWIND-PROTECT. --- ansi-tests/gclload2.lsp | 1 + ansi-tests/tagbody.lsp | 7 --- ansi-tests/unwind-protect.lsp | 90 +++++++++++++++++++++++++++++++++++ 3 files changed, 91 insertions(+), 7 deletions(-) create mode 100644 ansi-tests/unwind-protect.lsp diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index d0381c43..c0da9fc4 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -31,6 +31,7 @@ (load "macrolet.lsp") (load "progv.lsp") (load "tagbody.lsp") +(load "unwind-protect.lsp") ;;; Tests of conses diff --git a/ansi-tests/tagbody.lsp b/ansi-tests/tagbody.lsp index d6c0bee2..89e1738b 100644 --- a/ansi-tests/tagbody.lsp +++ b/ansi-tests/tagbody.lsp @@ -113,10 +113,3 @@ a) result) 20) - - - - - - - diff --git a/ansi-tests/unwind-protect.lsp b/ansi-tests/unwind-protect.lsp new file mode 100644 index 00000000..03d6fd3e --- /dev/null +++ b/ansi-tests/unwind-protect.lsp @@ -0,0 +1,90 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 14:41:16 2002 +;;;; Contains: Tests of UNWIND-PROTECT + +(in-package :cl-test) + +(deftest unwind-protect.1 + (let ((x nil)) + (unwind-protect + (push 1 x) + (incf (car x)))) + (2)) + +(deftest unwind-protect.2 + (let ((x nil)) + (block foo + (unwind-protect + (progn (push 1 x) (return-from foo x)) + (incf (car x))))) + (2)) + +(deftest unwind-protect.3 + (let ((x nil)) + (tagbody + (unwind-protect + (progn (push 1 x) (go done)) + (incf (car x))) + done) + x) + (2)) + +(deftest unwind-protect.4 + (let ((x nil)) + (catch 'done + (unwind-protect + (progn (push 1 x) (throw 'done x)) + (incf (car x))))) + (2)) + +(deftest unwind-protect.5 + (let ((x nil)) + (ignore-errors + (unwind-protect + (progn (push 1 x) (error "Boo!")) + (incf (car x)))) + x) + (2)) + +(deftest unwind-protect.6 + (let ((x nil)) + (block done + (flet ((%f () (return-from done nil))) + (unwind-protect (%f) + (push 'a x)))) + x) + (a)) + +(deftest unwind-protect.7 + (let ((x nil)) + (block done + (flet ((%f () (return-from done nil))) + (unwind-protect + (unwind-protect (%f) + (push 'b x)) + (push 'a x)))) + x) + (a b)) + +(deftest unwind-protect.8 + (let ((x nil)) + (block done + (unwind-protect + (flet ((%f () (return-from done nil))) + (unwind-protect + (unwind-protect (%f) + (push 'b x)) + (push 'a x))) + (push 'c x))) + x) + (c a b)) + +(deftest unwind-protect.9 + (let ((x nil)) + (handler-case + (flet ((%f () (error 'type-error :datum 'foo :expected-type nil))) + (unwind-protect (handler-case (%f)) + (push 'a x))) + (type-error () x))) + (a)) -- GitLab