annotate tests/automated/lisp-tests.el @ 384:bbff43aa5eb7 r21-2-7

Import from CVS: tag r21-2-7
author cvs
date Mon, 13 Aug 2007 11:08:24 +0200
parents
children aabb7f5b1c81
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
384
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
2
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
3 ;; Author: Martin Buchholz <martin@xemacs.org>
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
5 ;; Created: 1998
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
6 ;; Keywords: tests
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
7
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
9
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
13 ;; any later version.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
14
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
18 ;; General Public License for more details.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
19
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
24
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
25 ;;; Synched up with: not in FSF Emacs.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
26
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
27 ;;; Commentary:
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
28
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
29 ;;; Test basic Lisp engine functionality
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
30 ;;; See test-harness.el for instructions on how to run these tests.
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
31
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
32 (eval-when-compile
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
33 (condition-case nil
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
34 (require 'test-harness)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
35 (file-error
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
36 (push "." load-path)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
37 (when (and (boundp 'load-file-name) (stringp load-file-name))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
38 (push (file-name-directory load-file-name) load-path))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
39 (require 'test-harness))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
40
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
41 (Check-Error wrong-number-of-arguments (setq setq-test-foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
42 (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
43 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
44 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
45 (Assert (eq (setq) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
46 (Assert (eq (setq-default) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
47 (Assert (eq (setq setq-test-foo 42) 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
48 (Assert (eq (setq-default setq-test-foo 42) 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
49 (Assert (eq (setq setq-test-foo 42 setq-test-bar 99) 99))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
50 (Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
51
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
52 (macrolet ((test-setq (expected-result &rest body)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
53 `(progn
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
54 (defun test-setq-fun () ,@body)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
55 (Assert (eq ,expected-result (test-setq-fun)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
56 (byte-compile 'test-setq-fun)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
57 (Assert (eq ,expected-result (test-setq-fun))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
58 (test-setq nil (setq))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
59 (test-setq nil (setq-default))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
60 (test-setq 42 (setq test-setq-var 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
61 (test-setq 42 (setq-default test-setq-var 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
62 (test-setq 42 (setq test-setq-bar 99 test-setq-var 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
63 (test-setq 42 (setq-default test-setq-bar 99 test-setq-var 42))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
64 )
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
65
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
66 (let ((my-vector [1 2 3 4])
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
67 (my-bit-vector (bit-vector 1 0 1 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
68 (my-string "1234")
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
69 (my-list '(1 2 3 4)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
70
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
71 ;;(Assert (fooooo)) ;; Generate Other failure
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
72 ;;(Assert (eq 1 2)) ;; Generate Assertion failure
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
73
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
74 (dolist (sequence (list my-vector my-bit-vector my-string my-list))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
75 (Assert (sequencep sequence))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
76 (Assert (eq 4 (length sequence))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
77
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
78 (dolist (array (list my-vector my-bit-vector my-string))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
79 (Assert (arrayp array)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
80
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
81 (Assert (eq (elt my-vector 0) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
82 (Assert (eq (elt my-bit-vector 0) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
83 (Assert (eq (elt my-string 0) ?1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
84 (Assert (eq (elt my-list 0) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
85
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
86 (fillarray my-vector 5)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
87 (fillarray my-bit-vector 1)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
88 (fillarray my-string ?5)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
89
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
90 (dolist (array (list my-vector my-bit-vector))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
91 (Assert (eq 4 (length array))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
92
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
93 (Assert (eq (elt my-vector 0) 5))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
94 (Assert (eq (elt my-bit-vector 0) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
95 (Assert (eq (elt my-string 0) ?5))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
96
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
97 (Assert (eq (elt my-vector 3) 5))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
98 (Assert (eq (elt my-bit-vector 3) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
99 (Assert (eq (elt my-string 3) ?5))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
100
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
101 (fillarray my-bit-vector 0)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
102 (Assert (eq 4 (length my-bit-vector)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
103 (Assert (eq (elt my-bit-vector 2) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
104 )
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
105
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
106 (defun make-circular-list (length)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
107 "Create evil emacs-crashing circular list of length LENGTH"
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
108 (let ((circular-list
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
109 (make-list
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
110 length
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
111 'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
112 (setcdr (last circular-list) circular-list)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
113 circular-list))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
114
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
115 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
116 ;; Test `nconc'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
117 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
118 (defun make-list-012 () (list 0 1 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
119
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
120 (Check-Error wrong-type-argument (nconc 'foo nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
121
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
122 (dolist (length `(1 2 3 4 1000 2000))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
123 (Check-Error circular-list (nconc (make-circular-list length) 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
124 (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
125 (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
126
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
127 (Assert (eq (nconc) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
128 (Assert (eq (nconc nil) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
129 (Assert (eq (nconc nil nil) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
130 (Assert (eq (nconc nil nil nil) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
131
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
132 (let ((x (make-list-012))) (Assert (eq (nconc nil x) x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
133 (let ((x (make-list-012))) (Assert (eq (nconc x nil) x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
134 (let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
135 (let ((x (make-list-012))) (Assert (eq (nconc x) x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
136 (let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
137
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
138 (Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
139
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
140 (let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
141 (Assert (eq (length y) 6))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
142 (Assert (eq (nth 3 y) 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
143
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
144 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
145 ;; Test `last'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
146 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
147 (Check-Error wrong-type-argument (last 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
148 (Check-Error wrong-number-of-arguments (last))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
149 (Check-Error wrong-number-of-arguments (last '(1 2) 1 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
150 (Check-Error circular-list (last (make-circular-list 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
151 (Check-Error circular-list (last (make-circular-list 2000)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
152 (let ((x (list 0 1 2 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
153 (Assert (eq (last nil) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
154 (Assert (eq (last x 0) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
155 (Assert (eq (last x ) (cdddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
156 (Assert (eq (last x 1) (cdddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
157 (Assert (eq (last x 2) (cddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
158 (Assert (eq (last x 3) (cdr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
159 (Assert (eq (last x 4) x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
160 (Assert (eq (last x 9) x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
161 (Assert (eq (last `(1 . 2) 0) 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
162 )
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
163
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
164 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
165 ;; Test `butlast' and `nbutlast'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
166 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
167 (Check-Error wrong-type-argument (butlast 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
168 (Check-Error wrong-type-argument (nbutlast 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
169 (Check-Error wrong-number-of-arguments (butlast))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
170 (Check-Error wrong-number-of-arguments (nbutlast))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
171 (Check-Error wrong-number-of-arguments (butlast '(1 2) 1 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
172 (Check-Error wrong-number-of-arguments (nbutlast '(1 2) 1 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
173 (Check-Error circular-list (butlast (make-circular-list 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
174 (Check-Error circular-list (nbutlast (make-circular-list 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
175 (Check-Error circular-list (butlast (make-circular-list 2000)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
176 (Check-Error circular-list (nbutlast (make-circular-list 2000)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
177
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
178 (let* ((x (list 0 1 2 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
179 (y (butlast x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
180 (z (nbutlast x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
181 (Assert (eq z x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
182 (Assert (not (eq y x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
183 (Assert (equal y '(0 1 2)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
184 (Assert (equal z y)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
185
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
186 (let* ((x (list 0 1 2 3 4))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
187 (y (butlast x 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
188 (z (nbutlast x 2)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
189 (Assert (eq z x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
190 (Assert (not (eq y x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
191 (Assert (equal y '(0 1 2)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
192 (Assert (equal z y)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
193
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
194 (let* ((x (list 0 1 2 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
195 (y (butlast x 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
196 (z (nbutlast x 0)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
197 (Assert (eq z x))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
198 (Assert (not (eq y x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
199 (Assert (equal y '(0 1 2 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
200 (Assert (equal z y)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
201
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
202 (Assert (eq (butlast '(x)) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
203 (Assert (eq (nbutlast '(x)) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
204 (Assert (eq (butlast '()) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
205 (Assert (eq (nbutlast '()) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
206
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
207 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
208 ;; Test `copy-list'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
209 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
210 (Check-Error wrong-type-argument (copy-list 'foo))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
211 (Check-Error wrong-number-of-arguments (copy-list))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
212 (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
213 (Check-Error circular-list (copy-list (make-circular-list 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
214 (Check-Error circular-list (copy-list (make-circular-list 2000)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
215 (Assert (eq '() (copy-list '())))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
216 (dolist (x `((1) (1 2) (1 2 3) (1 2 . 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
217 (let ((y (copy-list x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
218 (Assert (and (equal x y) (not (eq x y))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
219
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
220 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
221 ;; Arithmetic operations
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
222 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
223
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
224 ;; Test `+'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
225 (Assert (eq (+ 1 1) 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
226 (Assert (= (+ 1.0 1.0) 2.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
227 (Assert (= (+ 1.0 3.0 0.0) 4.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
228 (Assert (= (+ 1 1.0) 2.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
229 (Assert (= (+ 1.0 1) 2.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
230 (Assert (= (+ 1.0 1 1) 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
231 (Assert (= (+ 1 1 1.0) 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
232
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
233 ;; Test `-'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
234 (Check-Error wrong-number-of-arguments (-))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
235 (Assert (eq (- 0) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
236 (Assert (eq (- 1) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
237 (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
238 (Assert (= (+ 1 one) 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
239 (Assert (= (+ one) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
240 (Assert (= (+ one) one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
241 (Assert (= (- one) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
242 (Assert (= (- one one) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
243 (Assert (= (- one one one) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
244 (Assert (= (+ one 1) 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
245 (dolist (zero `(0 0.0 ?\0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
246 (Assert (= (+ 1 zero) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
247 (Assert (= (+ zero 1) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
248 (Assert (= (- zero) zero))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
249 (Assert (= (- zero) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
250 (Assert (= (- zero zero) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
251 (Assert (= (- zero one one) -2))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
252
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
253 (Assert (= (- 1.5 1) .5))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
254 (Assert (= (- 1 1.5) (- .5)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
255
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
256 ;; Test `/'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
257
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
258 ;; Test division by zero errors
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
259 (dolist (zero `(0 0.0 ?\0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
260 (Check-Error arith-error (/ zero))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
261 (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
262 (Check-Error arith-error (/ n1 zero))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
263 (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
264 (Check-Error arith-error (/ n1 n2 zero)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
265
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
266 ;; Other tests for `/'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
267 (Check-Error wrong-number-of-arguments (/))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
268 (let (x)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
269 (Assert (= (/ (setq x 2)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
270 (Assert (= (/ (setq x 2.0)) 0.5)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
271
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
272 (dolist (six `(6 6.0 ?\06))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
273 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
274 (dolist (three `(3 3.0 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
275 (Assert (= (/ six two) three)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
276
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
277 (dolist (three `(3 3.0 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
278 (Assert (= (/ three 2.0) 1.5)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
279 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
280 (Assert (= (/ 3.0 two) 1.5)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
281
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
282 ;; Test `*'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
283 (Assert (= 1 (*)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
284
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
285 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
286 (Assert (= 1 (* one))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
287
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
288 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
289 (Assert (= 2 (* two))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
290
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
291 (dolist (six `(6 6.0 ?\06))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
292 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
293 (dolist (three `(3 3.0 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
294 (Assert (= (* three two) six)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
295
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
296 (dolist (three `(3 3.0 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
297 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
298 (Assert (= (* 1.5 two) three))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
299 (dolist (five `(5 5.0 ?\05))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
300 (Assert (= 30 (* five two three))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
301
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
302 ;; Test `+'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
303 (Assert (= 0 (+)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
304
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
305 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
306 (Assert (= 1 (+ one))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
307
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
308 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
309 (Assert (= 2 (+ two))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
310
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
311 (dolist (five `(5 5.0 ?\05))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
312 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
313 (dolist (three `(3 3.0 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
314 (Assert (= (+ three two) five))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
315 (Assert (= 10 (+ five two three))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
316
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
317 ;; Test `max', `min'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
318 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
319 (Assert (= one (max one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
320 (Assert (= one (max one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
321 (Assert (= one (max one one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
322 (Assert (= one (min one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
323 (Assert (= one (min one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
324 (Assert (= one (min one one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
325 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
326 (Assert (= one (min one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
327 (Assert (= one (min one two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
328 (Assert (= one (min two two one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
329 (Assert (= two (max one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
330 (Assert (= two (max one two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
331 (Assert (= two (max two two one)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
332
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
333 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
334 ;; Logical bit-twiddling operations
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
335 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
336 (Assert (= (logxor) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
337 (Assert (= (logior) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
338 (Assert (= (logand) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
339
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
340 (Check-Error wrong-type-argument (logxor 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
341 (Check-Error wrong-type-argument (logior 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
342 (Check-Error wrong-type-argument (logand 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
343
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
344 (dolist (three `(3 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
345 (Assert (eq 3 (logand three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
346 (Assert (eq 3 (logxor three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
347 (Assert (eq 3 (logior three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
348 (Assert (eq 3 (logand three three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
349 (Assert (eq 0 (logxor three three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
350 (Assert (eq 3 (logior three three))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
351
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
352 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
353 (dolist (two `(2 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
354 (Assert (eq 0 (logand one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
355 (Assert (eq 3 (logior one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
356 (Assert (eq 3 (logxor one two))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
357 (dolist (three `(3 ?\03))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
358 (Assert (eq 1 (logand one three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
359 (Assert (eq 3 (logior one three)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
360 (Assert (eq 2 (logxor one three)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
361
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
362 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
363 ;; Test `%', mod
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
364 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
365 (Check-Error wrong-number-of-arguments (%))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
366 (Check-Error wrong-number-of-arguments (% 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
367 (Check-Error wrong-number-of-arguments (% 1 2 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
368
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
369 (Check-Error wrong-number-of-arguments (mod))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
370 (Check-Error wrong-number-of-arguments (mod 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
371 (Check-Error wrong-number-of-arguments (mod 1 2 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
372
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
373 (Check-Error wrong-type-argument (% 10.0 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
374 (Check-Error wrong-type-argument (% 10 2.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
375
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
376 (dotimes (j 30)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
377 (let ((x (- (random) (random))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
378 (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
379 (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
380 (Assert (eq (% x -17) (- (% (- x) 17))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
381 ))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
382
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
383 (macrolet
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
384 ((division-test (seven)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
385 `(progn
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
386 (Assert (eq (% ,seven 2) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
387 (Assert (eq (% ,seven -2) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
388 (Assert (eq (% (- ,seven) 2) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
389 (Assert (eq (% (- ,seven) -2) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
390
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
391 (Assert (eq (% ,seven 4) 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
392 (Assert (eq (% ,seven -4) 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
393 (Assert (eq (% (- ,seven) 4) -3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
394 (Assert (eq (% (- ,seven) -4) -3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
395
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
396 (Assert (eq (% 35 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
397 (Assert (eq (% -35 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
398 (Assert (eq (% 35 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
399 (Assert (eq (% -35 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
400
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
401 (Assert (eq (mod ,seven 2) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
402 (Assert (eq (mod ,seven -2) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
403 (Assert (eq (mod (- ,seven) 2) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
404 (Assert (eq (mod (- ,seven) -2) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
405
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
406 (Assert (eq (mod ,seven 4) 3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
407 (Assert (eq (mod ,seven -4) -1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
408 (Assert (eq (mod (- ,seven) 4) 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
409 (Assert (eq (mod (- ,seven) -4) -3))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
410
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
411 (Assert (eq (mod 35 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
412 (Assert (eq (mod -35 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
413 (Assert (eq (mod 35 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
414 (Assert (eq (mod -35 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
415
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
416 (Assert (= (mod ,seven 2.0) 1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
417 (Assert (= (mod ,seven -2.0) -1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
418 (Assert (= (mod (- ,seven) 2.0) 1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
419 (Assert (= (mod (- ,seven) -2.0) -1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
420
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
421 (Assert (= (mod ,seven 4.0) 3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
422 (Assert (= (mod ,seven -4.0) -1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
423 (Assert (= (mod (- ,seven) 4.0) 1.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
424 (Assert (= (mod (- ,seven) -4.0) -3.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
425
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
426 (Assert (eq (% 0 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
427 (Assert (eq (% 0 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
428
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
429 (Assert (eq (mod 0 ,seven) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
430 (Assert (eq (mod 0 (- ,seven)) 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
431
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
432 (Assert (= (mod 0.0 ,seven) 0.0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
433 (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
434
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
435 (division-test 7)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
436 (division-test ?\07)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
437 (division-test (Int-to-Marker 7)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
438
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
439
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
440
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
441 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
442 ;; Arithmetic comparison operations
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
443 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
444 (Check-Error wrong-number-of-arguments (=))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
445 (Check-Error wrong-number-of-arguments (<))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
446 (Check-Error wrong-number-of-arguments (>))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
447 (Check-Error wrong-number-of-arguments (<=))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
448 (Check-Error wrong-number-of-arguments (>=))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
449 (Check-Error wrong-number-of-arguments (/=))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
450
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
451 ;; One argument always yields t
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
452 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
453 (Assert (eq t (= x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
454 (Assert (eq t (< x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
455 (Assert (eq t (> x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
456 (Assert (eq t (>= x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
457 (Assert (eq t (<= x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
458 (Assert (eq t (/= x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
459 )
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
460
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
461 ;; Type checking
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
462 (Check-Error wrong-type-argument (= 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
463 (Check-Error wrong-type-argument (<= 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
464 (Check-Error wrong-type-argument (>= 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
465 (Check-Error wrong-type-argument (< 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
466 (Check-Error wrong-type-argument (> 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
467 (Check-Error wrong-type-argument (/= 'foo 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
468
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
469 ;; Meat
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
470 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
471 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
472 (Assert (< one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
473 (Assert (<= one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
474 (Assert (<= two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
475 (Assert (> two one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
476 (Assert (>= two one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
477 (Assert (>= two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
478 (Assert (/= one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
479 (Assert (not (/= two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
480 (Assert (not (< one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
481 (Assert (not (> one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
482 (Assert (<= one one two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
483 (Assert (not (< one one two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
484 (Assert (>= two two one one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
485 (Assert (not (> two two one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
486 (Assert (= one one one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
487 (Assert (not (= one one one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
488 (Assert (not (/= one two one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
489 ))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
490
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
491 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
492 (dolist (two `(2 2.0 ?\02))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
493 (Assert (< one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
494 (Assert (<= one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
495 (Assert (<= two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
496 (Assert (> two one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
497 (Assert (>= two one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
498 (Assert (>= two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
499 (Assert (/= one two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
500 (Assert (not (/= two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
501 (Assert (not (< one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
502 (Assert (not (> one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
503 (Assert (<= one one two two))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
504 (Assert (not (< one one two two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
505 (Assert (>= two two one one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
506 (Assert (not (> two two one one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
507 (Assert (= one one one))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
508 (Assert (not (= one one one two)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
509 (Assert (not (/= one two one)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
510 ))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
511
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
512 ;; ad-hoc
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
513 (Assert (< 1 2))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
514 (Assert (< 1 2 3 4 5 6))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
515 (Assert (not (< 1 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
516 (Assert (not (< 2 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
517
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
518
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
519 (Assert (not (< 1 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
520 (Assert (< 1 2 3 4 5 6))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
521 (Assert (<= 1 2 3 4 5 6))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
522 (Assert (<= 1 2 3 4 5 6 6))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
523 (Assert (not (< 1 2 3 4 5 6 6)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
524 (Assert (<= 1 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
525
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
526 (Assert (not (eq (point) (point-marker))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
527 (Assert (= 1 (Int-to-Marker 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
528 (Assert (= (point) (point-marker)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
529
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
530 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
531 ;; testing list-walker functions
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
532 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
533 (macrolet
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
534 ((test-fun
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
535 (fun)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
536 `(progn
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
537 (Check-Error wrong-number-of-arguments (,fun))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
538 (Check-Error wrong-number-of-arguments (,fun nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
539 (Check-Error malformed-list (,fun nil 1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
540 ,@(loop for n in `(1 2 2000)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
541 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
542 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
543
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
544 (test-funs member old-member
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
545 memq old-memq
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
546 assoc old-assoc
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
547 rassoc old-rassoc
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
548 rassq old-rassq
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
549 delete old-delete
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
550 delq old-delq
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
551 remassoc remassq remrassoc remrassq))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
552
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
553 (let ((x '((1 . 2) 3 (4 . 5))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
554 (Assert (eq (assoc 1 x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
555 (Assert (eq (assq 1 x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
556 (Assert (eq (rassoc 1 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
557 (Assert (eq (rassq 1 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
558 (Assert (eq (assoc 2 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
559 (Assert (eq (assq 2 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
560 (Assert (eq (rassoc 2 x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
561 (Assert (eq (rassq 2 x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
562 (Assert (eq (assoc 3 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
563 (Assert (eq (assq 3 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
564 (Assert (eq (rassoc 3 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
565 (Assert (eq (rassq 3 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
566 (Assert (eq (assoc 4 x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
567 (Assert (eq (assq 4 x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
568 (Assert (eq (rassoc 4 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
569 (Assert (eq (rassq 4 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
570 (Assert (eq (assoc 5 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
571 (Assert (eq (assq 5 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
572 (Assert (eq (rassoc 5 x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
573 (Assert (eq (rassq 5 x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
574 (Assert (eq (assoc 6 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
575 (Assert (eq (assq 6 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
576 (Assert (eq (rassoc 6 x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
577 (Assert (eq (rassq 6 x) nil)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
578
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
579 (let ((x '(("1" . "2") "3" ("4" . "5"))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
580 (Assert (eq (assoc "1" x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
581 (Assert (eq (assq "1" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
582 (Assert (eq (rassoc "1" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
583 (Assert (eq (rassq "1" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
584 (Assert (eq (assoc "2" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
585 (Assert (eq (assq "2" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
586 (Assert (eq (rassoc "2" x) (car x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
587 (Assert (eq (rassq "2" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
588 (Assert (eq (assoc "3" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
589 (Assert (eq (assq "3" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
590 (Assert (eq (rassoc "3" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
591 (Assert (eq (rassq "3" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
592 (Assert (eq (assoc "4" x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
593 (Assert (eq (assq "4" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
594 (Assert (eq (rassoc "4" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
595 (Assert (eq (rassq "4" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
596 (Assert (eq (assoc "5" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
597 (Assert (eq (assq "5" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
598 (Assert (eq (rassoc "5" x) (caddr x)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
599 (Assert (eq (rassq "5" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
600 (Assert (eq (assoc "6" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
601 (Assert (eq (assq "6" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
602 (Assert (eq (rassoc "6" x) nil))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
603 (Assert (eq (rassq "6" x) nil)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
604
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
605 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
606 (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
607 (Assert (let* ((x (a)) (y (remassq 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
608 (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
609 (Assert (let* ((x (a)) (y (remrassq 1 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
610
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
611 (Assert (let* ((x (a)) (y (remassoc 2 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
612 (Assert (let* ((x (a)) (y (remassq 2 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
613 (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
614 (Assert (let* ((x (a)) (y (remrassq 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
615
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
616 (Assert (let* ((x (a)) (y (remassoc 3 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
617 (Assert (let* ((x (a)) (y (remassq 3 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
618 (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
619 (Assert (let* ((x (a)) (y (remrassq 3 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
620
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
621 (Assert (let* ((x (a)) (y (remassoc 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
622 (Assert (let* ((x (a)) (y (remassq 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
623 (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
624 (Assert (let* ((x (a)) (y (remrassq 4 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
625
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
626 (Assert (let* ((x (a)) (y (remassoc 5 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
627 (Assert (let* ((x (a)) (y (remassq 5 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
628 (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
629 (Assert (let* ((x (a)) (y (remrassq 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
630
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
631 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
632 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
633 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
634 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
635
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
636 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
637 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
638 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
639 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
640
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
641 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
642 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
643 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
644 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
645 )
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
646
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
647
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
648
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
649 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
650 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
651 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
652 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
653 (Assert (let* ((x (a)) (y (remrassq "1" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
654
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
655 (Assert (let* ((x (a)) (y (remassoc "2" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
656 (Assert (let* ((x (a)) (y (remassq "2" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
657 (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
658 (Assert (let* ((x (a)) (y (remrassq "2" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
659
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
660 (Assert (let* ((x (a)) (y (remassoc "3" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
661 (Assert (let* ((x (a)) (y (remassq "3" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
662 (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
663 (Assert (let* ((x (a)) (y (remrassq "3" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
664
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
665 (Assert (let* ((x (a)) (y (remassoc "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
666 (Assert (let* ((x (a)) (y (remassq "4" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
667 (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
668 (Assert (let* ((x (a)) (y (remrassq "4" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
669
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
670 (Assert (let* ((x (a)) (y (remassoc "5" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
671 (Assert (let* ((x (a)) (y (remassq "5" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
672 (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
673 (Assert (let* ((x (a)) (y (remrassq "5" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
674
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
675 (Assert (let* ((x (a)) (y (remassoc "6" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
676 (Assert (let* ((x (a)) (y (remassq "6" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
677 (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
678 (Assert (let* ((x (a)) (y (remrassq "6" x))) (and (eq x y) (equal y (a))))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
679
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
680 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
681 ;; function-max-args, function-min-args
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
682 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
683 (defmacro check-function-argcounts (fun min max)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
684 `(progn
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
685 (Assert (eq (function-min-args ,fun) ,min))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
686 (Assert (eq (function-max-args ,fun) ,max))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
687
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
688 (check-function-argcounts 'prog1 1 nil) ; special form
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
689 (check-function-argcounts 'command-execute 1 3) ; normal subr
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
690 (check-function-argcounts 'funcall 1 nil) ; `MANY' subr
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
691 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
692
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
693 ;; Test interpreted and compiled functions
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
694 (loop for (arglist min max) in
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
695 '(((arg1 arg2 &rest args) 2 nil)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
696 ((arg1 arg2 &optional arg3 arg4) 2 4)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
697 ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
698 (() 0 0))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
699 do
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
700 (eval
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
701 `(progn
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
702 (defun test-fun ,arglist nil)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
703 (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
704 (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
705
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
706 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
707 ;; Detection of cyclic variable indirection loops
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
708 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
709 (fset 'test-sym1 'test-sym1)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
710 (Check-Error cyclic-function-indirection (test-sym1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
711
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
712 (fset 'test-sym1 'test-sym2)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
713 (fset 'test-sym2 'test-sym1)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
714 (Check-Error cyclic-function-indirection (test-sym1))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
715 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
716 (fmakunbound 'test-sym2)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
717
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
718 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
719 ;; Test `type-of'
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
720 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
721 (Assert (eq (type-of load-path) 'cons))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
722 (Assert (eq (type-of obarray) 'vector))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
723 (Assert (eq (type-of 42) 'integer))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
724 (Assert (eq (type-of ?z) 'character))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
725 (Assert (eq (type-of "42") 'string))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
726 (Assert (eq (type-of 'foo) 'symbol))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
727 (Assert (eq (type-of (selected-device)) 'device))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
728
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
729 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
730 ;; Test mapping functions
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
731 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
732 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
733 (Assert (equal (mapcar #'identity load-path) load-path))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
734 (Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
735 (Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
736 (Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
737 (Assert (equal (mapcar #'identity #*010) '(0 1 0)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
738
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
739 (let ((z 0) (list (make-list 1000 1)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
740 (mapc (lambda (x) (incf z x)) list)
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
741 (Assert (eq 1000 z)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
742
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
743 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
744 (Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
745 (Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
746 (Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
747 (Assert (equal (mapvector #'identity #*010) [0 1 0]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
748
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
749 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
750 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
751 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
752
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
753 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
754 ;; Test vector functions
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
755 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
756 (Assert (equal [1 2 3] [1 2 3]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
757 (Assert (equal [] []))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
758 (Assert (not (equal [1 2 3] [])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
759 (Assert (not (equal [1 2 3] [1 2 4])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
760 (Assert (not (equal [0 2 3] [1 2 3])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
761 (Assert (not (equal [1 2 3] [1 2 3 4])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
762 (Assert (not (equal [1 2 3 4] [1 2 3])))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
763 (Assert (equal (vector 1 2 3) [1 2 3]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
764 (Assert (equal (make-vector 3 1) [1 1 1]))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
765
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
766 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
767 ;; Test bit-vector functions
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
768 ;;-----------------------------------------------------
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
769 (Assert (equal #*010 #*010))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
770 (Assert (equal #* #*))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
771 (Assert (not (equal #*010 #*011)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
772 (Assert (not (equal #*010 #*)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
773 (Assert (not (equal #*110 #*010)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
774 (Assert (not (equal #*010 #*0100)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
775 (Assert (not (equal #*0101 #*010)))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
776 (Assert (equal (bit-vector 0 1 0) #*010))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
777 (Assert (equal (make-bit-vector 3 1) #*111))
bbff43aa5eb7 Import from CVS: tag r21-2-7
cvs
parents:
diff changeset
778 (Assert (equal (make-bit-vector 3 0) #*000))