changeset 5346:b4ef3128160c

Fix some testsuite failures, #'delete, #'delq, #'remove, #'remq. lisp/ChangeLog addition: 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete): * cl-macs.el (delq): * cl-macs.el (remove): * cl-macs.el (remq): Don't use the compiler macro if these functions were given the wrong number of arguments, as happens in lisp-tests.el. * cl-seq.el (remove, remq): Removed. I added these to subr.el, and forgot to remove them from here. tests/ChangeLog addition: 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (test-fun): #'delete* and friends can now throw a wrong-type-argument if handed a non-sequence; accept this too when checking for an error when passing a fixnum as the SEQUENCE argument. Check #'remove*, #'remove and #'remq too.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 23 Jan 2011 13:13:54 +0000
parents db326b8fe982
children fd441b85d760
files lisp/ChangeLog lisp/cl-macs.el lisp/cl-seq.el tests/ChangeLog tests/automated/lisp-tests.el
diffstat 5 files changed, 67 insertions(+), 59 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Jan 23 12:47:02 2011 +0000
+++ b/lisp/ChangeLog	Sun Jan 23 13:13:54 2011 +0000
@@ -1,3 +1,14 @@
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (delete):
+	* cl-macs.el (delq):
+	* cl-macs.el (remove):
+	* cl-macs.el (remq):
+	Don't use the compiler macro if these functions were given the
+	wrong number of arguments, as happens in lisp-tests.el.
+	* cl-seq.el (remove, remq): Removed.
+	I added these to subr.el, and forgot to remove them from here.
+
 2011-01-22  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* bytecomp.el (byte-compile-setq, byte-compile-set):
--- a/lisp/cl-macs.el	Sun Jan 23 12:47:02 2011 +0000
+++ b/lisp/cl-macs.el	Sun Jan 23 13:13:54 2011 +0000
@@ -3344,42 +3344,49 @@
     form))
 
 (define-compiler-macro delete (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro delq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'eq))))
+    form))
 
 (define-compiler-macro remove (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro remq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'eq))))
+    form))
  
 (macrolet
     ((define-foo-if-compiler-macros (&rest alist)
--- a/lisp/cl-seq.el	Sun Jan 23 12:47:02 2011 +0000
+++ b/lisp/cl-seq.el	Sun Jan 23 13:13:54 2011 +0000
@@ -56,26 +56,6 @@
 ;; scope (e.g. a variable called start bound in this file and one in a
 ;; user-supplied test predicate may well interfere with each other).
 
-;; XEmacs change: these two are in subr.el in GNU Emacs.
-(defun remove (cl-item cl-seq)
-  "Remove all occurrences of ITEM in SEQUENCE, testing with `equal'.
-
-This is a non-destructive function; it makes a copy of SEQUENCE if necessary
-to avoid corrupting the original SEQUENCE.
-Also see: `remove*', `delete', `delete*'
-
-arguments: (ITEM SEQUENCE)"
-  (remove* cl-item cl-seq :test #'equal))
-
-(defun remq (cl-item cl-seq)
-  "Remove all occurrences of ITEM in SEQUENCE, comparing with `eq'.
-
-This is a non-destructive function; it makes a copy of SEQUENCE to avoid
-corrupting the original LIST.  See also the more general `remove*'.
-
-arguments: (ITEM SEQUENCE)"
-  (remove* cl-item cl-seq :test #'eq))
-
 (defun remove-if (cl-predicate cl-seq &rest cl-keys)
   "Remove all items satisfying PREDICATE in SEQUENCE.
 
--- a/tests/ChangeLog	Sun Jan 23 12:47:02 2011 +0000
+++ b/tests/ChangeLog	Sun Jan 23 13:13:54 2011 +0000
@@ -1,3 +1,11 @@
+2011-01-23  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el (test-fun):
+	#'delete* and friends can now throw a wrong-type-argument if
+	handed a non-sequence; accept this too when checking for an error
+	when passing a fixnum as the SEQUENCE argument.
+	Check #'remove*, #'remove and #'remq too.
+
 2011-01-15  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (list): Test #'concatenate, especially
--- a/tests/automated/lisp-tests.el	Sun Jan 23 12:47:02 2011 +0000
+++ b/tests/automated/lisp-tests.el	Sun Jan 23 13:13:54 2011 +0000
@@ -793,19 +793,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)))