Mercurial > hg > xemacs-beta
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)))