[cmucl/cmucl][master] Fix #5: Give better error message

[Raymond Toy]

Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
e791b596 by Raymond Toy at 2015-06-13T23:21:13Z
Fix #5: Give better error message

Give a better error message when using T clause in case

error.lisp:
o Add new invalid-case condition to handle errors from case
  expressions.

macros.lisp:
o Use new invalid-case condition to signal the invalid usage of T in
  CASE expressions.
o Replace old message with better, more informative, message. Include
  xref to ANSI CL spec.

exports.lisp:
o Export INVALID-CASE from KERNEL package.

- - - - -


3 changed files:

- src/code/error.lisp
- src/code/exports.lisp
- src/code/macros.lisp


Changes:

=====================================
src/code/error.lisp
=====================================
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -25,6 +25,7 @@
 	  simple-file-error simple-program-error simple-parse-error
           simple-style-warning simple-undefined-function
 	  constant-modified
+	  invalid-case
           #+stack-checking stack-overflow
           #+heap-overflow-check heap-overflow))
 
@@ -1115,7 +1116,20 @@
                      (constant-modified-function-name c))
 	     (print-references (reference-condition-references c) s)))
   (:default-initargs :references (list '(:ansi-cl :section (3 2 2 3)))))
-  
+
+;; For errors in CASE and friends.
+(define-condition invalid-case (reference-condition error)
+  ((name :initarg :name
+	 :reader invalid-case-name)
+   (format :initarg :format-control
+	   :reader invalid-case-format)
+   (args :initarg :format-arguments
+	 :reader invalid-case-format-args))
+  (:report (lambda (condition stream)
+	     (format stream "~A: " (invalid-case-name condition))
+	     (apply #'format stream (invalid-case-format condition) (invalid-case-format-args condition))
+	     (print-references (reference-condition-references condition) stream))))
+
 (define-condition arithmetic-error (error)
   ((operation :reader arithmetic-error-operation :initarg :operation
 	      :initform nil)


=====================================
src/code/exports.lisp
=====================================
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -2538,7 +2538,8 @@
 
 	   "SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-P"
 	   "OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-ERROR"
-	   "DD-PI"))
+	   "DD-PI"
+	   "INVALID-CASE"))
 
 (dolist
     (name


=====================================
src/code/macros.lisp
=====================================
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -1366,7 +1366,16 @@
 			(error (intl:gettext "No default clause allowed in ~S: ~S") name case)
 			(push `(t nil ,@(rest case)) clauses)))
 		   ((and (eq name 'case))
-		    (error (intl:gettext "T and OTHERWISE may not be used as key designators for ~A") name))
+		    (let ((key (first case)))
+		      (error 'kernel:invalid-case
+			     :name name
+			     :format-control (intl:gettext
+					      "~<~A is a key designator only in the final otherwise-clause. ~
+                                              Use (~A) to use it as a normal-clause or move the clause to the ~
+                                              correct position.~:@>")
+			     :format-arguments (list (list key key))
+			     :references (list '(:ansi-cl :section (5 3))
+					       (list :ansi-cl :macro name)))))
 		   ((eq (first case) t)
 		    ;; The key T is normal clause, because it's not
 		    ;; the last clause.



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e791b596f0471f9027a95e8d5959f6324bf99ac1
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20150614/4ca12f1c/attachment.html>