From b3577ad7767f451490f5bfe7ba2e74efabe9f4e6 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 12 Apr 2007 17:29:30 +0000 Subject: [PATCH] 1.0.4.77: oops, forgot to cvs add a new file in .76 --- tests/case.pure.lisp | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 2 files changed, 54 insertions(+), 1 deletion(-) create mode 100644 tests/case.pure.lisp diff --git a/tests/case.pure.lisp b/tests/case.pure.lisp new file mode 100644 index 0000000..a7898e6 --- /dev/null +++ b/tests/case.pure.lisp @@ -0,0 +1,53 @@ +;;;; tests of the CASE family of macros without side effects + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(cl:in-package :cl-user) + +(loop + for (expected kind . clauses) in + '((nil + case (1 1) + (2 2) + (3 3)) + ("Duplicate key 1 in CASE form, occurring in the first clause: (1 1), and the second clause: (1 2)" + case (1 1) + (1 2)) + ("Duplicate key 2 in CASE form, occurring in the first clause: ((1 2) 1), and the second clause: ((2 3) 2)" + case ((1 2) 1) + ((2 3) 2)) + (nil + case (#1=(1) 1) + ((#1#) 2))) + for form = `(lambda () + (,kind *readtable* + ,@clauses)) + do + (multiple-value-bind (fun warnings-p failure-p) + (handler-bind ((style-warning (lambda (c) + (if expected + (assert (search expected + (with-standard-io-syntax + (let ((*print-right-margin* nil) + (*print-pretty* t)) + (remove #\Newline (princ-to-string c))))) + () + "~S should have warned ~S, but instead warned: ~A" form expected c) + (error "~S shouldn't give a warning, but did: ~A" form c)) + (setf expected nil)))) + (compile nil form)) + (assert (functionp fun)) + (assert (null expected) + () + "~S should have warned ~S, but didn't." + form expected) + (assert (not failure-p)))) diff --git a/version.lisp-expr b/version.lisp-expr index 847e76e..94d18a4 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.4.76" +"1.0.4.77" -- 1.7.10.4