Permalink
Browse files

plain T and OTHERWISE not allowed in CASE normal-clauses

  lp#959687
  • Loading branch information...
1 parent fe4b3e4 commit a4c8f8ac2bbbd24cd0a886c75d8a250269b3b1e5 @nikodemus nikodemus committed Mar 28, 2012
Showing with 33 additions and 0 deletions.
  1. +2 −0 NEWS
  2. +11 −0 src/code/macros.lisp
  3. +20 −0 tests/compiler.pure.lisp
View
@@ -2,6 +2,8 @@
changes relative to sbcl-1.0.55:
* bug fix: SB-SIMPLE-STREAMS signals an error for bogus :CLASS arguments in
OPEN. (lp#969352, thanks to Kambiz Darabi)
+ * bug fix: CASE normal-clauses do not allow T and OTHERWISE as keys.
+ (lp#959687)
* documentation:
** improved docstrings: REPLACE (lp#965592)
View
@@ -261,6 +261,17 @@ invoked. In that case it will store into PLACE and start over."
,@forms)
clauses))
(t
+ (when (and (eq name 'case)
+ (cdr cases)
+ (memq keyoid '(t otherwise)))
+ (error 'simple-reference-error
+ :format-control
+ "~@<~IBad ~S clause:~:@_ ~S~:@_~S allowed as the key ~
+ designator only in the final otherwise-clause, not in a ~
+ normal-clause. Use (~S) instead, or move the clause the ~
+ correct position.~:@>"
+ :format-arguments (list 'case case keyoid keyoid)
+ :references `((:ansi-cl :macro case))))
(push keyoid keys)
(check-clause (list keyoid))
(push `((,test ,keyform-value ',keyoid)
@@ -4179,3 +4179,23 @@
(declare (optimize speed)
(type (and fixnum a) x))
x)))
+
+(with-test (:name :bug-959687)
+ (multiple-value-bind (fun warn fail)
+ (compile nil `(lambda (x)
+ (case x
+ (t
+ :its-a-t)
+ (otherwise
+ :somethign-else))))
+ (assert (and warn fail))
+ (assert (not (ignore-errors (funcall fun t)))))
+ (multiple-value-bind (fun warn fail)
+ (compile nil `(lambda (x)
+ (case x
+ (otherwise
+ :its-an-otherwise)
+ (t
+ :somethign-else))))
+ (assert (and warn fail))
+ (assert (not (ignore-errors (funcall fun t))))))

0 comments on commit a4c8f8a

Please sign in to comment.