--- a/lisp/ChangeLog	Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/ChangeLog	Wed Nov 17 14:30:03 2010 +0000
@@ -1,3 +1,13 @@
+2010-11-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-extra.el (coerce):
+	In the argument list, name the first argument OBJECT, not X; the
+	former name was always used in the doc string and is clearer.
+	Handle vector type specifications which include the length of the
+	target sequence, error if there's a mismatch.
+	* cl-macs.el (cl-make-type-test): Handle type specifications
+	starting with the symbol 'eql.
+
 2010-11-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el (eql): Don't remove the byte-compile property of this

--- a/lisp/cl-extra.el	Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-extra.el	Wed Nov 17 14:30:03 2010 +0000
@@ -53,47 +53,67 @@
 
 ;;; Type coercion.
 
-(defun coerce (x type)
+(defun coerce (object type)
   "Coerce OBJECT to type TYPE.
 TYPE is a Common Lisp type specifier."
-  (cond ((eq type 'list) (if (listp x) x (append x nil)))
-	((eq type 'vector) (if (vectorp x) x (vconcat x)))
-	((eq type 'string) (if (stringp x) x (concat x)))
-	((eq type 'array) (if (arrayp x) x (vconcat x)))
-	((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
-	((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+  (cond ((eq type 'list) (if (listp object) object (append object nil)))
+	((eq type 'vector) (if (vectorp object) object (vconcat object)))
+	((eq type 'string) (if (stringp object) object (concat object)))
+	((eq type 'array) (if (arrayp object) object (vconcat object)))
+	((and (eq type 'character) (stringp object)
+	      (eql (length object) 1)) (aref object 0))
+	((and (eq type 'character) (symbolp object))
+	 (coerce (symbol-name object) type))
 	;; XEmacs addition character <-> integer coercions
-	((and (eq type 'character) (char-int-p x)) (int-char x))
-	((and (memq type '(integer fixnum)) (characterp x)) (char-int x))
-	((eq type 'float) (float x))
+	((and (eq type 'character) (char-int-p object)) (int-char object))
+	((and (memq type '(integer fixnum)) (characterp object))
+	 (char-int object))
+	((eq type 'float) (float object))
 	;; XEmacs addition: enhanced numeric type coercions
 	((and-fboundp 'coerce-number
 	   (memq type '(integer ratio bigfloat fixnum))
-	   (coerce-number x type)))
+	   (coerce-number object type)))
 	;; XEmacs addition: bit-vector coercion
 	((or (eq type 'bit-vector)
 	     (eq type 'simple-bit-vector))
-	 (if (bit-vector-p x) x (apply 'bit-vector (append x nil))))
+	 (if (bit-vector-p object)
+	     object
+	   (apply 'bit-vector (append object nil))))
 	;; XEmacs addition: weak-list coercion
 	((eq type 'weak-list)
-	 (if (weak-list-p x) x
+	 (if (weak-list-p object) object
 	   (let ((wl (make-weak-list)))
-	     (set-weak-list-list wl (if (listp x) x (append x nil)))
+	     (set-weak-list-list wl (if (listp object)
+					object
+				      (append object nil)))
 	     wl)))
 	((and
-	  (consp type)
-	  (or (eq (car type) 'vector)
-	      (eq (car type) 'simple-array)
-	      (eq (car type) 'simple-vector))
-	  (cond
-	   ((equal (cdr-safe type) '(*))
-	    (coerce x 'vector))
-	   ((equal (cdr-safe type) '(bit))
-	    (coerce x 'bit-vector))
-	   ((equal (cdr-safe type) '(character))
-	    (coerce x 'string)))))
-	((typep x type) x)
-	(t (error "Can't coerce %s to type %s" x type))))
+	  (memq (car-safe type) '(vector simple-array))
+	  (loop
+	    for (ignore elements length) = type
+	    initially (declare (special ignore))
+	    return (if (or (memq length '(* nil)) (eql length (length object)))
+		       (cond
+			((memq elements '(t * nil))
+			 (coerce object 'vector))
+			((memq elements '(string-char character))
+			 (coerce object 'string))
+			((eq elements 'bit)
+			 (coerce object 'bit-vector)))
+		     (error 
+		      'wrong-type-argument
+		      "Type specifier length must equal sequence length"
+		      type)))))
+	((eq (car-safe type) 'simple-vector)
+	 (coerce object (list* 'vector t (cdr type))))
+	((memq (car-safe type)
+	       '(string simple-string base-string simple-base-string))
+	 (coerce object (list* 'vector 'character (cdr type))))
+	((eq (car-safe type) 'bit-vector)
+	 (coerce object (list* 'vector 'bit (cdr type))))
+	((typep object type) object)
+	(t (error 'invalid-operation
+		  "Can't coerce object to type" object type))))
 
 ;; XEmacs; #'equalp is in C.
 

--- a/lisp/cl-macs.el	Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-macs.el	Wed Nov 17 14:30:03 2010 +0000
@@ -3116,6 +3116,8 @@
 			 (cdr type))))
 	  ((memq (car-safe type) '(member member*))
 	   (list 'and (list 'member* val (list 'quote (cdr type))) t))
+	  ((eq (car-safe type) 'eql)
+	   (list 'eql (cadr type) val))
 	  ((eq (car-safe type) 'satisfies) (list (cadr type) val))
 	  (t (error "Bad type spec: %s" type)))))