Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5374:d967d96ca043

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Conditionalise the old-* functions and byte codes at compile time. src/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * config.h.in (SUPPORT_CONFOUNDING_FUNCTIONS): New #define, equivalent NEED_TO_HANDLE_21_4_CODE by default, describing whether this XEmacs should support the old-eq, old-equal and related functions and byte codes. * bytecode.c (UNUSED): Only interpret old-eq, old-equal, old-memq if SUPPORT_CONFOUNDING_FUNCTIONS is defined. * data.c: Move Fold_eq to fns.c with the rest of the Fold_* functions. * fns.c: * fns.c (Fmemq): * fns.c (memq_no_quit): * fns.c (assoc_no_quit): * fns.c (Frassq): * fns.c (Fequal): * fns.c (Fold_equal): * fns.c (syms_of_fns): Group old-eq, old-equal, old-memq etc together, surround them with #ifdef SUPPORT_CONFOUNDING_FUNCTIONS. lisp/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: Don't generate the old-eq, old-memq, old-equal bytecodes any more, but keep the information about them around for the sake of the disassembler. man/ChangeLog addition: 2011-03-15 Aidan Kehoe <kehoea@parhasard.net> * lispref/objects.texi (Character Type): * lispref/objects.texi (Equality Predicates): No longer document `old-eq', `old-equal', they haven't been used in years. tests/ChangeLog addition: 2011-03-17 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Only test the various old-* function if old-eq is bound and a subr.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 17 Mar 2011 20:13:00 +0000
parents 4c4b96b13f70
children 97ac18bd1fa3 ac37a5f7e5be
comparison
equal deleted inserted replaced
5372:6c3a695f54f5 5374:d967d96ca043
794 (Check-Error wrong-number-of-arguments (,fun)) 794 (Check-Error wrong-number-of-arguments (,fun))
795 (Check-Error wrong-number-of-arguments (,fun nil)) 795 (Check-Error wrong-number-of-arguments (,fun nil))
796 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1)) 796 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1))
797 ,@(loop for n in '(1 2 2000) 797 ,@(loop for n in '(1 2 2000)
798 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n)))))) 798 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
799 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))) 799 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))
800 800 (test-old-funs (&rest funs)
801 `(when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
802 ,@(loop for fun in funs collect `(test-fun ,fun)))))
801 (test-funs member* member memq 803 (test-funs member* member memq
802 assoc* assoc assq 804 assoc* assoc assq
803 rassoc* rassoc rassq 805 rassoc* rassoc rassq
804 delete* delete delq 806 delete* delete delq
805 remove* remove remq 807 remove* remove remq
806 old-member old-memq 808 remassoc remassq remrassoc remrassq)
807 old-assoc old-assq 809 (test-old-funs old-member old-memq old-assoc old-assq old-rassoc old-rassq
808 old-rassoc old-rassq 810 old-delete old-delq))
809 old-delete old-delq
810 remassoc remassq remrassoc remrassq))
811 811
812 (let ((x '((1 . 2) 3 (4 . 5)))) 812 (let ((x '((1 . 2) 3 (4 . 5))))
813 (Assert (eq (assoc 1 x) (car x))) 813 (Assert (eq (assoc 1 x) (car x)))
814 (Assert (eq (assq 1 x) (car x))) 814 (Assert (eq (assq 1 x) (car x)))
815 (Assert (eq (rassoc 1 x) nil)) 815 (Assert (eq (rassoc 1 x) nil))
889 889
890 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a))))) 890 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a)))))
891 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a))))) 891 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a)))))
892 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a))))) 892 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
893 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a))))) 893 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a)))))
894
895 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) 894 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
896 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5)))))) 895 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
897 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
898 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
899
900 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) 896 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
901 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) 897 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
902 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5)))))) 898 (when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
903 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a))))) 899 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
904 ) 900 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
905 901 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
906 902 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))))
907 903
908 (flet ((a () (list '("1" . "2") "3" '("4" . "5")))) 904 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
909 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5")))))) 905 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
910 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a))))) 906 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a)))))
911 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a))))) 907 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))