From 03b9f51cd26986a385f370409acd05d23f67f83d Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 12 Oct 2002 19:24:49 +0000 Subject: [PATCH] Added tests for TAGBODY --- ansi-tests/gclload2.lsp | 1 + ansi-tests/tagbody.lsp | 122 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 123 insertions(+) create mode 100644 ansi-tests/tagbody.lsp diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 449d9ed0..d0381c43 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -30,6 +30,7 @@ (load "let.lsp") (load "macrolet.lsp") (load "progv.lsp") +(load "tagbody.lsp") ;;; Tests of conses diff --git a/ansi-tests/tagbody.lsp b/ansi-tests/tagbody.lsp new file mode 100644 index 00000000..d6c0bee2 --- /dev/null +++ b/ansi-tests/tagbody.lsp @@ -0,0 +1,122 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 12 13:27:22 2002 +;;;; Contains: Tests of TAGBODY + +(in-package :cl-test) + +(deftest tagbody.1 + (tagbody) + nil) + +(deftest tagbody.2 + (tagbody 'a) + nil) + +(deftest tagbody.3 + (tagbody (values)) + nil) + +(deftest tagbody.4 + (tagbody (values 1 2 3 4 5)) + nil) + +(deftest tagbody.5 + (let ((x 0)) + (values + (tagbody + (setq x 1) + (go a) + (setq x 2) + a) + x)) + nil 1) + +(deftest tagbody.6 + (let ((x 0)) + (tagbody + (setq x 1) + (go a) + b + (setq x 2) + (go c) + a + (setq x 3) + (go b) + c) + x) + 2) + +;;; Macroexpansion occurs after tag determination +(deftest tagbody.7 + (let ((x 0)) + (macrolet ((%m () 'a)) + (tagbody + (tagbody + (go a) + (%m) + (setq x 1)) + a )) + x) + 0) + +(deftest tagbody.8 + (let ((x 0)) + (tagbody + (flet ((%f (y) (setq x y) (go a))) + (%f 10)) + (setq x 1) + a) + x) + 10) + +;;; Tag names are in their own name space +(deftest tagbody.9 + (let (result) + (tagbody + (flet ((a (x) x)) + (setq result (a 10)) + (go a)) + a) + result) + 10) + +(deftest tagbody.10 + (let (result) + (tagbody + (block a + (setq result 10) + (go a)) + (setq result 20) + a) + result) + 10) + +(deftest tagbody.11 + (let (result) + (tagbody + (catch 'a + (setq result 10) + (go a)) + (setq result 20) + a) + result) + 10) + +(deftest tagbody.12 + (let (result) + (tagbody + (block a + (setq result 10) + (return-from a nil)) + (setq result 20) + a) + result) + 20) + + + + + + + -- GitLab