--- a/tests/automated/lisp-tests.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/tests/automated/lisp-tests.el	Mon Feb 07 21:22:17 2011 +0100
@@ -791,19 +791,21 @@
       `(progn
 	 (Check-Error wrong-number-of-arguments (,fun))
 	 (Check-Error wrong-number-of-arguments (,fun nil))
-	 (Check-Error malformed-list (,fun nil 1))
+	 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1))
 	 ,@(loop for n in '(1 2 2000)
 	     collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
      (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
 
-  (test-funs member* member old-member 
-	     memq   old-memq
-	     assoc* assoc  old-assoc
-	     rassoc* rassoc old-rassoc
-	     rassq  old-rassq
-	     delete* delete old-delete
-	     delq   old-delq
-	     remassoc remassq remrassoc remrassq))
+  (test-funs member* member memq 
+             assoc* assoc assq 
+             rassoc* rassoc rassq 
+             delete* delete delq 
+             remove* remove remq 
+             old-member old-memq 
+             old-assoc old-assq 
+             old-rassoc old-rassq 
+             old-delete old-delq 
+             remassoc remassq remrassoc remrassq))
 
 (let ((x '((1 . 2) 3 (4 . 5))))
   (Assert (eq (assoc  1 x) (car x)))
@@ -2678,115 +2680,154 @@
         (string (make-string string-length
                              (or (decode-char 'ucs #x20ac) ?\xFF)))
         (item 'cons))
-    (dolist (function '(count position find delete* remove* reduce))
-      (Check-Error args-out-of-range
-                   (funcall function item list
-                            :start (1+ list-length) :end (1+ list-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function item list
-                            :start -1 :end list-length))
-      (Check-Error args-out-of-range
-                   (funcall function item list :end (* 2 list-length)))
-      (Check-Error args-out-of-range
-                   (funcall function item vector
-                            :start (1+ vector-length) :end (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function item vector :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function item vector :end (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function item bit-vector
-                            :start (1+ vector-length) :end (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function item bit-vector :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function item bit-vector :end (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function item string
-                            :start (1+ string-length) :end (1+ string-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function item string :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function item string :end (* 2 string-length))))
-    (dolist (function '(delete-duplicates remove-duplicates))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence list)
-                            :start (1+ list-length) :end (1+ list-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence list)
-                            :start -1 :end list-length))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence list)
-                            :end (* 2 list-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence vector)
-                            :start (1+ vector-length) :end (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence vector) :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence vector)
-                            :end (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence bit-vector)
-                            :start (1+ vector-length) :end (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence bit-vector) :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence bit-vector)
-                            :end (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence string)
-                            :start (1+ string-length) :end (1+ string-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence string) :start -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence string)
-                            :end (* 2 string-length))))
-    (dolist (function '(replace mismatch search))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence list) (copy-sequence list)
-                            :start1 (1+ list-length) :end1 (1+ list-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence list) (copy-sequence list)
-                            :start1 -1 :end1 list-length))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence list) (copy-sequence list)
-                            :end1 (* 2 list-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence vector)
-                            (copy-sequence vector) :start1 (1+ vector-length)
-                            :end1 (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence vector)
-                            (copy-sequence vector) :start1 -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence vector)
-                            (copy-sequence vector)
-                            :end1 (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence bit-vector)
-                            (copy-sequence bit-vector)
-                            :start1 (1+ vector-length)
-                            :end1 (1+ vector-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence bit-vector)
-                            (copy-sequence bit-vector) :start1 -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence bit-vector)
-                            (copy-sequence bit-vector)
-                            :end1 (* 2 vector-length)))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence string)
-                            (copy-sequence string)
-                            :start1 (1+ string-length)
-                            :end1 (1+ string-length)))
-      (Check-Error wrong-type-argument
-                   (funcall function (copy-sequence string)
-                            (copy-sequence string) :start1 -1))
-      (Check-Error args-out-of-range
-                   (funcall function (copy-sequence string)
-                            (copy-sequence string)
-                            :end1 (* 2 string-length))))))
+    (macrolet
+        ((construct-item-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function item list
+                                           :start (1+ list-length)
+                                           :end (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item list :start -1
+                                           :end list-length))
+                   (Check-Error args-out-of-range
+                                (,function item list :end (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function item vector
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item vector :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item vector
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function item bit-vector
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item bit-vector :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item bit-vector
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function item string
+                                           :start (1+ string-length)
+                                           :end (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function item string :start -1))
+                   (Check-Error args-out-of-range
+                                (,function item string
+                                           :end (* 2 string-length)))))
+             functions)))
+         (construct-one-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           :start (1+ list-length)
+                                           :end (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence list)
+                                           :start -1 :end list-length))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           :end (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence vector) :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           :start (1+ vector-length)
+                                           :end (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence bit-vector)
+                                           :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           :end (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           :start (1+ string-length)
+                                           :end (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence string) :start -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           :end (* 2 string-length)))))
+             functions)))
+         (construct-two-sequence-checks (&rest functions)
+           (cons
+            'progn
+            (mapcan
+             #'(lambda (function)
+                 `((Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :start1 (1+ list-length)
+                                           :end1 (1+ list-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :start1 -1 :end1 list-length))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence list)
+                                           (copy-sequence list)
+                                           :end1 (* 2 list-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           (copy-sequence vector)
+                                           :start1 (1+ vector-length)
+                                           :end1 (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function
+                                 (copy-sequence vector)
+                                 (copy-sequence vector) :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence vector)
+                                           (copy-sequence vector)
+                                           :end1 (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :start1 (1+ vector-length)
+                                           :end1 (1+ vector-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence bit-vector)
+                                           (copy-sequence bit-vector)
+                                           :end1 (* 2 vector-length)))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           (copy-sequence string)
+                                           :start1 (1+ string-length)
+                                           :end1 (1+ string-length)))
+                   (Check-Error wrong-type-argument
+                                (,function (copy-sequence string)
+                                           (copy-sequence string) :start1 -1))
+                   (Check-Error args-out-of-range
+                                (,function (copy-sequence string)
+                                           (copy-sequence string)
+                                           :end1 (* 2 string-length)))))
+             functions))))
+      (construct-item-sequence-checks count position find delete* remove*
+                                      reduce)
+      (construct-one-sequence-checks delete-duplicates remove-duplicates)
+      (construct-two-sequence-checks replace mismatch search))))
 
 (let* ((list (list 1 2 3 4 5 6 7 120 'hi-there '#:everyone))
        (vector (map 'vector #'identity list))
@@ -2828,4 +2869,33 @@
 					 (subseq bit-vector 0 4)
 					 (append (subseq bit-vector 4) nil)))))
 
+;;-----------------------------------------------------
+;; Test `block', `return-from'
+;;-----------------------------------------------------
+(Assert (eql 1 (block outer
+		 (flet ((outtahere (n) (return-from outer n)))
+		   (block outer (outtahere 1)))
+		 2))
+	"checking `block' and `return-from' are lexically scoped correctly")
+
+;; Other tests are available in Paul Dietz' test suite, and pass. The above,
+;; which we used to fail, is based on a test in the Hyperspec. We still
+;; behave incorrectly when compiled for the contorted-example function of
+;; CLTL2, whence the following test:
+
+(flet ((needs-lexical-context (first second third)
+	 (if (eql 0 first)
+	     (funcall second)
+	   (block awkward
+	     (+ 5 (needs-lexical-context
+		   (1- first)
+		   third
+		   #'(lambda () (return-from awkward 0)))
+		first)))))
+  (if (compiled-function-p (symbol-function 'needs-lexical-context))
+      (Known-Bug-Expect-Failure
+       (Assert (eql 0 (needs-lexical-context 2 nil nil))
+	"the function special operator doesn't create a lexical context."))
+    (Assert (eql 0 (needs-lexical-context 2 nil nil)))))
+
 ;;; end of lisp-tests.el