APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1295788434 0 # Node ID b4ef3128160cd912415eee1f987c2b9fe631c5fc # Parent db326b8fe982a75108885e02eb035e6eadb8768e Fix some testsuite failures, #'delete, #'delq, #'remove, #'remq. lisp/ChangeLog addition: 2011-01-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * 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. diff -r db326b8fe982 -r b4ef3128160c lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * bytecomp.el (byte-compile-setq, byte-compile-set): diff -r db326b8fe982 -r b4ef3128160c lisp/cl-macs.el --- 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) diff -r db326b8fe982 -r b4ef3128160c lisp/cl-seq.el --- 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. diff -r db326b8fe982 -r b4ef3128160c tests/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * automated/lisp-tests.el (list): Test #'concatenate, especially diff -r db326b8fe982 -r b4ef3128160c tests/automated/lisp-tests.el --- 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))) -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches