From 8412195bfb681da255b79806b97990cf0d3c1ed3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 19 Aug 2015 19:09:45 +0200
Subject: [PATCH] ctypecase: fix invalid tests (constant assignment)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
---
 ctypecase.lsp | 13 ++++++++++---
 typecase.lsp  | 19 +++++++++++++++++++
 2 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/ctypecase.lsp b/ctypecase.lsp
index 0bdc5cad..15404adb 100644
--- a/ctypecase.lsp
+++ b/ctypecase.lsp
@@ -99,9 +99,15 @@
      (return-from done 'good)))
   good)
 
-;;; Test that explicit calls to macroexpand in subforms
-;;; are done in the correct environment
-
+;; Following tests (ctypecase.15 and ctypecase.16) are invalid, since
+;; ctypecase provides restart, which evaluates to assignment to :foo,
+;; which is constant. Both tests were transformed into valid ones and
+;; moved to typecase.lsp (typecase.22 and typecase.23).
+;;
+;; Related discussion:
+;; https://mailman.common-lisp.net/pipermail/ansi-test-devel/2012-January/000108.html
+
+#+(or)
 (deftest ctypecase.15
   (macrolet
    ((%m (z) z))
@@ -112,6 +118,7 @@
     (symbol :bad2)))
   :good)
 
+#+(or)
 (deftest ctypecase.16
   (macrolet
    ((%m (z) z))
diff --git a/typecase.lsp b/typecase.lsp
index 50a02817..925baeae 100644
--- a/typecase.lsp
+++ b/typecase.lsp
@@ -142,6 +142,25 @@
              (t (expand-in-current-env (%m :bad2)))))
   :good)
 
+(deftest typecase.22
+  (macrolet
+   ((%m (z) z))
+   (typecase
+    (expand-in-current-env (%m :foo))
+    (integer :bad1)
+    (keyword :good)
+    (symbol :bad2)))
+  :good)
+
+(deftest typecase.23
+  (macrolet
+   ((%m (z) z))
+   (typecase :foo
+    (integer (expand-in-current-env (%m :bad1)))
+    (keyword (expand-in-current-env (%m :good)))
+    (symbol (expand-in-current-env (%m :bad2)))))
+  :good)
+
 ;;; Error cases
 
 (deftest typecase.error.1
-- 
GitLab