annotate tests/automated/lisp-tests.el @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents 5aa1854ad537
children 74cb069b8417
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Author: Martin Buchholz <martin@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Created: 1998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Keywords: tests
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Test basic Lisp engine functionality
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; See test-harness.el for instructions on how to run these tests.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 (eval-when-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 (require 'test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 (push "." load-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (when (and (boundp 'load-file-name) (stringp load-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 (push (file-name-directory load-file-name) load-path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (require 'test-harness))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 (Check-Error wrong-number-of-arguments (setq setq-test-foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 (Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 (Assert (eq (setq) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 (Assert (eq (setq-default) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 (Assert (eq (setq setq-test-foo 42) 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 (Assert (eq (setq-default setq-test-foo 42) 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 (Assert (eq (setq setq-test-foo 42 setq-test-bar 99) 99))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 (Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (macrolet ((test-setq (expected-result &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 `(progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 (defun test-setq-fun () ,@body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 (Assert (eq ,expected-result (test-setq-fun)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (byte-compile 'test-setq-fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (Assert (eq ,expected-result (test-setq-fun))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (test-setq nil (setq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (test-setq nil (setq-default))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (test-setq 42 (setq test-setq-var 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (test-setq 42 (setq-default test-setq-var 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 (test-setq 42 (setq test-setq-bar 99 test-setq-var 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (test-setq 42 (setq-default test-setq-bar 99 test-setq-var 42))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (let ((my-vector [1 2 3 4])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (my-bit-vector (bit-vector 1 0 1 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (my-string "1234")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 (my-list '(1 2 3 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;;(Assert (fooooo)) ;; Generate Other failure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;;(Assert (eq 1 2)) ;; Generate Assertion failure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 (dolist (sequence (list my-vector my-bit-vector my-string my-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (Assert (sequencep sequence))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (Assert (eq 4 (length sequence))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (dolist (array (list my-vector my-bit-vector my-string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (Assert (arrayp array)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (Assert (eq (elt my-vector 0) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (Assert (eq (elt my-bit-vector 0) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (Assert (eq (elt my-string 0) ?1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (Assert (eq (elt my-list 0) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (fillarray my-vector 5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (fillarray my-bit-vector 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (fillarray my-string ?5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (dolist (array (list my-vector my-bit-vector))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (Assert (eq 4 (length array))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (Assert (eq (elt my-vector 0) 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (Assert (eq (elt my-bit-vector 0) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (Assert (eq (elt my-string 0) ?5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (Assert (eq (elt my-vector 3) 5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (Assert (eq (elt my-bit-vector 3) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (Assert (eq (elt my-string 3) ?5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (fillarray my-bit-vector 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (Assert (eq 4 (length my-bit-vector)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (Assert (eq (elt my-bit-vector 2) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (defun make-circular-list (length)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 "Create evil emacs-crashing circular list of length LENGTH"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (let ((circular-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 (make-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 length
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (setcdr (last circular-list) circular-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 circular-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 ;; Test `nconc'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (defun make-list-012 () (list 0 1 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (Check-Error wrong-type-argument (nconc 'foo nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (dolist (length '(1 2 3 4 1000 2000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (Check-Error circular-list (nconc (make-circular-list length) 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (Assert (eq (nconc) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (Assert (eq (nconc nil) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (Assert (eq (nconc nil nil) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (Assert (eq (nconc nil nil nil) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (let ((x (make-list-012))) (Assert (eq (nconc nil x) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (let ((x (make-list-012))) (Assert (eq (nconc x nil) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (let ((x (make-list-012))) (Assert (eq (nconc x) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (Assert (eq (length y) 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (Assert (eq (nth 3 y) 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 ;; Test `last'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 (Check-Error wrong-type-argument (last 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (Check-Error wrong-number-of-arguments (last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (Check-Error wrong-number-of-arguments (last '(1 2) 1 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (Check-Error circular-list (last (make-circular-list 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (Check-Error circular-list (last (make-circular-list 2000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (let ((x (list 0 1 2 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (Assert (eq (last nil) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (Assert (eq (last x 0) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (Assert (eq (last x ) (cdddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (Assert (eq (last x 1) (cdddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 (Assert (eq (last x 2) (cddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (Assert (eq (last x 3) (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (Assert (eq (last x 4) x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (Assert (eq (last x 9) x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 (Assert (eq (last '(1 . 2) 0) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 ;; Test `butlast' and `nbutlast'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (Check-Error wrong-type-argument (butlast 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (Check-Error wrong-type-argument (nbutlast 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (Check-Error wrong-number-of-arguments (butlast))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (Check-Error wrong-number-of-arguments (nbutlast))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (Check-Error wrong-number-of-arguments (butlast '(1 2) 1 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (Check-Error wrong-number-of-arguments (nbutlast '(1 2) 1 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (Check-Error circular-list (butlast (make-circular-list 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (Check-Error circular-list (nbutlast (make-circular-list 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (Check-Error circular-list (butlast (make-circular-list 2000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (Check-Error circular-list (nbutlast (make-circular-list 2000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (let* ((x (list 0 1 2 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (y (butlast x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (z (nbutlast x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (Assert (eq z x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (Assert (not (eq y x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (Assert (equal y '(0 1 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (Assert (equal z y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (let* ((x (list 0 1 2 3 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (y (butlast x 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 (z (nbutlast x 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (Assert (eq z x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (Assert (not (eq y x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (Assert (equal y '(0 1 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (Assert (equal z y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (let* ((x (list 0 1 2 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (y (butlast x 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (z (nbutlast x 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (Assert (eq z x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (Assert (not (eq y x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (Assert (equal y '(0 1 2 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (Assert (equal z y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (Assert (eq (butlast '(x)) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (Assert (eq (nbutlast '(x)) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (Assert (eq (butlast '()) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (Assert (eq (nbutlast '()) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 ;; Test `copy-list'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (Check-Error wrong-type-argument (copy-list 'foo))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (Check-Error wrong-number-of-arguments (copy-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (Check-Error wrong-number-of-arguments (copy-list '(1 2) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (Check-Error circular-list (copy-list (make-circular-list 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (Check-Error circular-list (copy-list (make-circular-list 2000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (Assert (eq '() (copy-list '())))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 (dolist (x '((1) (1 2) (1 2 3) (1 2 . 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (let ((y (copy-list x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (Assert (and (equal x y) (not (eq x y))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 ;; Arithmetic operations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 ;; Test `+'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 (Assert (eq (+ 1 1) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 (Assert (= (+ 1.0 1.0) 2.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (Assert (= (+ 1.0 3.0 0.0) 4.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 (Assert (= (+ 1 1.0) 2.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 (Assert (= (+ 1.0 1) 2.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 (Assert (= (+ 1.0 1 1) 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 (Assert (= (+ 1 1 1.0) 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (Assert (eq (1+ most-positive-fixnum) most-negative-fixnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (Assert (eq (+ most-positive-fixnum 1) most-negative-fixnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 ;; Test `-'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (Check-Error wrong-number-of-arguments (-))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (Assert (eq (- 0) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (Assert (eq (- 1) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (Assert (= (+ 1 one) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (Assert (= (+ one) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 (Assert (= (+ one) one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (Assert (= (- one) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (Assert (= (- one one) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (Assert (= (- one one one) -1))
464
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 448
diff changeset
246 (Assert (= (- 0 one) -1))
5aa1854ad537 Import from CVS: tag r21-2-47
cvs
parents: 448
diff changeset
247 (Assert (= (- 0 one one) -2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (Assert (= (+ one 1) 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (dolist (zero '(0 0.0 ?\0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (Assert (= (+ 1 zero) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (Assert (= (+ zero 1) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (Assert (= (- zero) zero))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (Assert (= (- zero) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (Assert (= (- zero zero) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (Assert (= (- zero one one) -2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (Assert (= (- 1.5 1) .5))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (Assert (= (- 1 1.5) (- .5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (Assert (eq (1- most-negative-fixnum) most-positive-fixnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (Assert (eq (- most-negative-fixnum 1) most-positive-fixnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 ;; Test `/'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 ;; Test division by zero errors
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (dolist (zero '(0 0.0 ?\0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 (Check-Error arith-error (/ zero))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (Check-Error arith-error (/ n1 zero))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (Check-Error arith-error (/ n1 n2 zero)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ;; Other tests for `/'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (Check-Error wrong-number-of-arguments (/))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (let (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (Assert (= (/ (setq x 2)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (Assert (= (/ (setq x 2.0)) 0.5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (dolist (six '(6 6.0 ?\06))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 (dolist (three '(3 3.0 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 (Assert (= (/ six two) three)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (dolist (three '(3 3.0 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (Assert (= (/ three 2.0) 1.5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (Assert (= (/ 3.0 two) 1.5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 ;; Test `*'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (Assert (= 1 (*)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (Assert (= 1 (* one))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (Assert (= 2 (* two))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (dolist (six '(6 6.0 ?\06))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (dolist (three '(3 3.0 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (Assert (= (* three two) six)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 (dolist (three '(3 3.0 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (Assert (= (* 1.5 two) three))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (dolist (five '(5 5.0 ?\05))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (Assert (= 30 (* five two three))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 ;; Test `+'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (Assert (= 0 (+)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (Assert (= 1 (+ one))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (Assert (= 2 (+ two))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (dolist (five '(5 5.0 ?\05))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (dolist (three '(3 3.0 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (Assert (= (+ three two) five))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (Assert (= 10 (+ five two three))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ;; Test `max', `min'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 (Assert (= one (max one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (Assert (= one (max one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (Assert (= one (max one one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (Assert (= one (min one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (Assert (= one (min one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (Assert (= one (min one one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (Assert (= one (min one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (Assert (= one (min one two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (Assert (= one (min two two one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (Assert (= two (max one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (Assert (= two (max one two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (Assert (= two (max two two one)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
340 ;; The byte compiler has special handling for these constructs:
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
341 (let ((three 3) (five 5))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
342 (Assert (= (+ three five 1) 9))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
343 (Assert (= (+ 1 three five) 9))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
344 (Assert (= (+ three five -1) 7))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
345 (Assert (= (+ -1 three five) 7))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
346 (Assert (= (+ three 1) 4))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
347 (Assert (= (+ three -1) 2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
348 (Assert (= (+ -1 three) 2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
349 (Assert (= (+ -1 three) 2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
350 (Assert (= (- three five 1) -3))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
351 (Assert (= (- 1 three five) -7))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
352 (Assert (= (- three five -1) -1))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
353 (Assert (= (- -1 three five) -9))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
354 (Assert (= (- three 1) 2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
355 (Assert (= (- three 2 1) 0))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
356 (Assert (= (- 2 three 1) -2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
357 (Assert (= (- three -1) 4))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
358 (Assert (= (- three 0) 3))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
359 (Assert (= (- three 0 five) -2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
360 (Assert (= (- 0 three 0 five) -8))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
361 (Assert (= (- 0 three five) -8))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
362 (Assert (= (* three 2) 6))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
363 (Assert (= (* three -1 five) -15))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
364 (Assert (= (* three 1 five) 15))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
365 (Assert (= (* three 0 five) 0))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
366 (Assert (= (* three 2 five) 30))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
367 (Assert (= (/ three 1) 3))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
368 (Assert (= (/ three -1) -3))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
369 (Assert (= (/ (* five five) 2 2) 6))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
370 (Assert (= (/ 64 five 2) 6)))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
371
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
372
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 ;; Logical bit-twiddling operations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (Assert (= (logxor) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (Assert (= (logior) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (Assert (= (logand) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (Check-Error wrong-type-argument (logxor 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (Check-Error wrong-type-argument (logior 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (Check-Error wrong-type-argument (logand 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (dolist (three '(3 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (Assert (eq 3 (logand three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (Assert (eq 3 (logxor three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (Assert (eq 3 (logior three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (Assert (eq 3 (logand three three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (Assert (eq 0 (logxor three three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (Assert (eq 3 (logior three three))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (dolist (two '(2 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (Assert (eq 0 (logand one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (Assert (eq 3 (logior one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (Assert (eq 3 (logxor one two))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (dolist (three '(3 ?\03))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (Assert (eq 1 (logand one three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (Assert (eq 3 (logior one three)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (Assert (eq 2 (logxor one three)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 ;; Test `%', mod
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (Check-Error wrong-number-of-arguments (%))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (Check-Error wrong-number-of-arguments (% 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (Check-Error wrong-number-of-arguments (% 1 2 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (Check-Error wrong-number-of-arguments (mod))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (Check-Error wrong-number-of-arguments (mod 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (Check-Error wrong-number-of-arguments (mod 1 2 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (Check-Error wrong-type-argument (% 10.0 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (Check-Error wrong-type-argument (% 10 2.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (dotimes (j 30)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (let ((x (- (random) (random))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (Assert (eq (% x -17) (- (% (- x) 17))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (macrolet
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 ((division-test (seven)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 `(progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (Assert (eq (% ,seven 2) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (Assert (eq (% ,seven -2) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (Assert (eq (% (- ,seven) 2) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (Assert (eq (% (- ,seven) -2) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (Assert (eq (% ,seven 4) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (Assert (eq (% ,seven -4) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (Assert (eq (% (- ,seven) 4) -3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (Assert (eq (% (- ,seven) -4) -3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (Assert (eq (% 35 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (Assert (eq (% -35 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (Assert (eq (% 35 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (Assert (eq (% -35 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (Assert (eq (mod ,seven 2) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (Assert (eq (mod ,seven -2) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (Assert (eq (mod (- ,seven) 2) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (Assert (eq (mod (- ,seven) -2) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (Assert (eq (mod ,seven 4) 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (Assert (eq (mod ,seven -4) -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (Assert (eq (mod (- ,seven) 4) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (Assert (eq (mod (- ,seven) -4) -3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (Assert (eq (mod 35 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (Assert (eq (mod -35 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (Assert (eq (mod 35 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (Assert (eq (mod -35 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (Assert (= (mod ,seven 2.0) 1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (Assert (= (mod ,seven -2.0) -1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (Assert (= (mod (- ,seven) 2.0) 1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (Assert (= (mod (- ,seven) -2.0) -1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (Assert (= (mod ,seven 4.0) 3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (Assert (= (mod ,seven -4.0) -1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (Assert (= (mod (- ,seven) 4.0) 1.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (Assert (= (mod (- ,seven) -4.0) -3.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (Assert (eq (% 0 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (Assert (eq (% 0 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (Assert (eq (mod 0 ,seven) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (Assert (eq (mod 0 (- ,seven)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (Assert (= (mod 0.0 ,seven) 0.0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (division-test 7)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (division-test ?\07)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (division-test (Int-to-Marker 7)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 ;; Arithmetic comparison operations
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 (Check-Error wrong-number-of-arguments (=))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (Check-Error wrong-number-of-arguments (<))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 (Check-Error wrong-number-of-arguments (>))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (Check-Error wrong-number-of-arguments (<=))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (Check-Error wrong-number-of-arguments (>=))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (Check-Error wrong-number-of-arguments (/=))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 ;; One argument always yields t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (Assert (eq t (= x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (Assert (eq t (< x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (Assert (eq t (> x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (Assert (eq t (>= x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (Assert (eq t (<= x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (Assert (eq t (/= x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 ;; Type checking
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (Check-Error wrong-type-argument (= 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (Check-Error wrong-type-argument (<= 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (Check-Error wrong-type-argument (>= 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (Check-Error wrong-type-argument (< 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (Check-Error wrong-type-argument (> 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (Check-Error wrong-type-argument (/= 'foo 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 ;; Meat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (Assert (< one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (Assert (<= one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (Assert (<= two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (Assert (> two one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (Assert (>= two one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (Assert (>= two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (Assert (/= one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (Assert (not (/= two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (Assert (not (< one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (Assert (not (> one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (Assert (<= one one two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (Assert (not (< one one two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (Assert (>= two two one one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (Assert (not (> two two one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (Assert (= one one one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (Assert (not (= one one one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (Assert (not (/= one two one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 (dolist (two '(2 2.0 ?\02))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (Assert (< one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (Assert (<= one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (Assert (<= two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 (Assert (> two one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (Assert (>= two one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (Assert (>= two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (Assert (/= one two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (Assert (not (/= two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (Assert (not (< one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (Assert (not (> one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (Assert (<= one one two two))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (Assert (not (< one one two two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (Assert (>= two two one one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (Assert (not (> two two one one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (Assert (= one one one))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (Assert (not (= one one one two)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (Assert (not (/= one two one)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 ;; ad-hoc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (Assert (< 1 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (Assert (< 1 2 3 4 5 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (Assert (not (< 1 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 (Assert (not (< 2 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (Assert (not (< 1 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (Assert (< 1 2 3 4 5 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (Assert (<= 1 2 3 4 5 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 (Assert (<= 1 2 3 4 5 6 6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (Assert (not (< 1 2 3 4 5 6 6)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (Assert (<= 1 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (Assert (not (eq (point) (point-marker))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (Assert (= 1 (Int-to-Marker 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (Assert (= (point) (point-marker)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 ;; testing list-walker functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (macrolet
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 ((test-fun
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (fun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 `(progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (Check-Error wrong-number-of-arguments (,fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (Check-Error wrong-number-of-arguments (,fun nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (Check-Error malformed-list (,fun nil 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ,@(loop for n in '(1 2 2000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (test-funs member old-member
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 memq old-memq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 assoc old-assoc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 rassoc old-rassoc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 rassq old-rassq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 delete old-delete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 delq old-delq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 remassoc remassq remrassoc remrassq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (let ((x '((1 . 2) 3 (4 . 5))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (Assert (eq (assoc 1 x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (Assert (eq (assq 1 x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (Assert (eq (rassoc 1 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (Assert (eq (rassq 1 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 (Assert (eq (assoc 2 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (Assert (eq (assq 2 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 (Assert (eq (rassoc 2 x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (Assert (eq (rassq 2 x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (Assert (eq (assoc 3 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (Assert (eq (assq 3 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (Assert (eq (rassoc 3 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (Assert (eq (rassq 3 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (Assert (eq (assoc 4 x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (Assert (eq (assq 4 x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (Assert (eq (rassoc 4 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (Assert (eq (rassq 4 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (Assert (eq (assoc 5 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (Assert (eq (assq 5 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (Assert (eq (rassoc 5 x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (Assert (eq (rassq 5 x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 (Assert (eq (assoc 6 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (Assert (eq (assq 6 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (Assert (eq (rassoc 6 x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (Assert (eq (rassq 6 x) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (let ((x '(("1" . "2") "3" ("4" . "5"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (Assert (eq (assoc "1" x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 (Assert (eq (assq "1" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (Assert (eq (rassoc "1" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 (Assert (eq (rassq "1" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (Assert (eq (assoc "2" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (Assert (eq (assq "2" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (Assert (eq (rassoc "2" x) (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (Assert (eq (rassq "2" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (Assert (eq (assoc "3" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (Assert (eq (assq "3" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (Assert (eq (rassoc "3" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (Assert (eq (rassq "3" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (Assert (eq (assoc "4" x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (Assert (eq (assq "4" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (Assert (eq (rassoc "4" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (Assert (eq (rassq "4" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (Assert (eq (assoc "5" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (Assert (eq (assq "5" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (Assert (eq (rassoc "5" x) (caddr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (Assert (eq (rassq "5" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (Assert (eq (assoc "6" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (Assert (eq (assq "6" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 (Assert (eq (rassoc "6" x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 (Assert (eq (rassq "6" x) nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (flet ((a () (list '(1 . 2) 3 '(4 . 5))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (Assert (let* ((x (a)) (y (remassoc 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (Assert (let* ((x (a)) (y (remassq 1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (Assert (let* ((x (a)) (y (remrassq 1 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (Assert (let* ((x (a)) (y (remassoc 2 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (Assert (let* ((x (a)) (y (remassq 2 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (Assert (let* ((x (a)) (y (remrassq 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (Assert (let* ((x (a)) (y (remassoc 3 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (Assert (let* ((x (a)) (y (remassq 3 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (Assert (let* ((x (a)) (y (remrassq 3 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (Assert (let* ((x (a)) (y (remassoc 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (Assert (let* ((x (a)) (y (remassq 4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (Assert (let* ((x (a)) (y (remrassq 4 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (Assert (let* ((x (a)) (y (remassoc 5 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 (Assert (let* ((x (a)) (y (remassq 5 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (Assert (let* ((x (a)) (y (remrassq 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (Assert (let* ((x (a)) (y (remassoc 6 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (Assert (let* ((x (a)) (y (remassq 6 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 (Assert (let* ((x (a)) (y (remrassq 6 x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (Assert (let* ((x (a)) (y (delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (Assert (let* ((x (a)) (y (delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (Assert (let* ((x (a)) (y (old-delq 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (Assert (let* ((x (a)) (y (delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (Assert (let* ((x (a)) (y (delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (Assert (let* ((x (a)) (y (old-delq '(1 . 2) x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (Assert (let* ((x (a)) (y (remassoc "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (Assert (let* ((x (a)) (y (remassq "1" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (Assert (let* ((x (a)) (y (remrassq "1" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (Assert (let* ((x (a)) (y (remassoc "2" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (Assert (let* ((x (a)) (y (remassq "2" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (Assert (let* ((x (a)) (y (remrassq "2" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (Assert (let* ((x (a)) (y (remassoc "3" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (Assert (let* ((x (a)) (y (remassq "3" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (Assert (let* ((x (a)) (y (remrassq "3" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 (Assert (let* ((x (a)) (y (remassoc "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (Assert (let* ((x (a)) (y (remassq "4" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 (Assert (let* ((x (a)) (y (remrassq "4" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 (Assert (let* ((x (a)) (y (remassoc "5" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 (Assert (let* ((x (a)) (y (remassq "5" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 (Assert (let* ((x (a)) (y (remrassq "5" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (Assert (let* ((x (a)) (y (remassoc "6" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 (Assert (let* ((x (a)) (y (remassq "6" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (Assert (let* ((x (a)) (y (remrassq "6" x))) (and (eq x y) (equal y (a))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ;; function-max-args, function-min-args
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (defmacro check-function-argcounts (fun min max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 `(progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 (Assert (eq (function-min-args ,fun) ,min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (Assert (eq (function-max-args ,fun) ,max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (check-function-argcounts 'prog1 1 nil) ; special form
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (check-function-argcounts 'command-execute 1 3) ; normal subr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (check-function-argcounts 'funcall 1 nil) ; `MANY' subr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (check-function-argcounts 'garbage-collect 0 0) ; no args subr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 ;; Test interpreted and compiled functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 (loop for (arglist min max) in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 '(((arg1 arg2 &rest args) 2 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 ((arg1 arg2 &optional arg3 arg4) 2 4)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (() 0 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (eval
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 `(progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (defun test-fun ,arglist nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 ;; Detection of cyclic variable indirection loops
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (fset 'test-sym1 'test-sym1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (Check-Error cyclic-function-indirection (test-sym1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 (fset 'test-sym1 'test-sym2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (fset 'test-sym2 'test-sym1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (Check-Error cyclic-function-indirection (test-sym1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (fmakunbound 'test-sym2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 ;; Test `type-of'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (Assert (eq (type-of load-path) 'cons))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (Assert (eq (type-of obarray) 'vector))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (Assert (eq (type-of 42) 'integer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (Assert (eq (type-of ?z) 'character))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (Assert (eq (type-of "42") 'string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (Assert (eq (type-of 'foo) 'symbol))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (Assert (eq (type-of (selected-device)) 'device))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 ;; Test mapping functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (Check-Error wrong-type-argument (mapcar #'identity (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (Assert (equal (mapcar #'identity load-path) load-path))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (Assert (equal (mapcar #'identity '(1 2 3)) '(1 2 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (Assert (equal (mapcar #'identity "123") '(?1 ?2 ?3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (Assert (equal (mapcar #'identity [1 2 3]) '(1 2 3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (Assert (equal (mapcar #'identity #*010) '(0 1 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 (let ((z 0) (list (make-list 1000 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (mapc (lambda (x) (incf z x)) list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (Assert (eq 1000 z)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (Check-Error wrong-type-argument (mapvector #'identity (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (Assert (equal (mapvector #'identity '(1 2 3)) [1 2 3]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (Assert (equal (mapvector #'identity "123") [?1 ?2 ?3]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 (Assert (equal (mapvector #'identity [1 2 3]) [1 2 3]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (Assert (equal (mapvector #'identity #*010) [0 1 0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (Check-Error wrong-type-argument (mapconcat #'identity (current-buffer) "foo"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (Assert (equal (mapconcat #'identity '("1" "2" "3") "|") "1|2|3"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (Assert (equal (mapconcat #'identity ["1" "2" "3"] "|") "1|2|3"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
793 ;; The following 2 functions used to crash XEmacs via mapcar1().
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
794 ;; We don't test the actual values of the mapcar, since they're undefined.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
795 (Assert
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
796 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
797 (mapcar
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
798 (lambda (y)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
799 "Devious evil mapping function"
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
800 (when (eq (car y) 2) ; go out onto a limb
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
801 (setcdr x nil) ; cut it off behind us
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
802 (garbage-collect)) ; are we riding a magic broomstick?
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
803 (car y)) ; sorry, hard landing
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
804 x)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
805
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
806 (Assert
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
807 (let ((x (list (cons 1 1) (cons 2 2) (cons 3 3))))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
808 (mapcar
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
809 (lambda (y)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
810 "Devious evil mapping function"
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
811 (when (eq (car y) 1)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
812 (setcdr (cdr x) 42)) ; drop a brick wall onto the freeway
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
813 (car y))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
814 x)))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
815
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 ;; Test vector functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (Assert (equal [1 2 3] [1 2 3]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (Assert (equal [] []))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 (Assert (not (equal [1 2 3] [])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 (Assert (not (equal [1 2 3] [1 2 4])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 (Assert (not (equal [0 2 3] [1 2 3])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 (Assert (not (equal [1 2 3] [1 2 3 4])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 (Assert (not (equal [1 2 3 4] [1 2 3])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (Assert (equal (vector 1 2 3) [1 2 3]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (Assert (equal (make-vector 3 1) [1 1 1]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ;; Test bit-vector functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (Assert (equal #*010 #*010))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 (Assert (equal #* #*))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (Assert (not (equal #*010 #*011)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 (Assert (not (equal #*010 #*)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 (Assert (not (equal #*110 #*010)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (Assert (not (equal #*010 #*0100)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (Assert (not (equal #*0101 #*010)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 (Assert (equal (bit-vector 0 1 0) #*010))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (Assert (equal (make-bit-vector 3 1) #*111))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (Assert (equal (make-bit-vector 3 0) #*000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 ;; Test buffer-local variables used as (ugh!) function parameters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (make-local-variable 'test-emacs-buffer-local-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (byte-compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 (defun test-emacs-buffer-local-parameter (test-emacs-buffer-local-variable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (setq test-emacs-buffer-local-variable nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (test-emacs-buffer-local-parameter nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 ;; Test split-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 ;;-----------------------------------------------------
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 ;; Hrvoje didn't like these tests so I'm disabling them for now. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 ;(Assert (equal (split-string "foo" "") '("" "f" "o" "o" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 ;(Assert (equal (split-string "foo" "^") '("" "foo")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 ;(Assert (equal (split-string "foo" "$") '("foo" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 (Assert (equal (split-string "foo,bar" ",") '("foo" "bar")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (Assert (equal (split-string ",foo,bar," ",") '("" "foo" "bar" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (Assert (equal (split-string ",foo,bar," "^,") '("" "foo,bar,")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 (Assert (equal (split-string ",foo,bar," ",$") '(",foo,bar" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 (Assert (equal (split-string ",foo,,bar," ",") '("" "foo" "" "bar" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 (Assert (equal (split-string "foo,,,bar" ",") '("foo" "" "" "bar")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 (Assert (equal (split-string "foo,,bar,," ",") '("foo" "" "bar" "" "")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 (Assert (equal (split-string "foo,,bar" ",+") '("foo" "bar")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (Assert (equal (split-string ",foo,,bar," ",+") '("" "foo" "bar" "")))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
868
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
869 (Assert (not (string-match "\\(\\.\\=\\)" ".")))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
870 (Assert (string= "" (let ((str "test string"))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
871 (if (string-match "^.*$" str)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
872 (replace-match "\\U" t nil str)))))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
873 (with-temp-buffer
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
874 (erase-buffer)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
875 (insert "test string")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
876 (re-search-backward "^.*$")
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
877 (replace-match "\\U" t)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
878 (Assert (and (bobp) (eobp))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
879
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
880 ;;-----------------------------------------------------
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
881 ;; Test near-text buffer functions.
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
882 ;;-----------------------------------------------------
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
883 (with-temp-buffer
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
884 (erase-buffer)
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
885 (Assert (eq (char-before) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
886 (Assert (eq (char-before (point)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
887 (Assert (eq (char-before (point-marker)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
888 (Assert (eq (char-before (point) (current-buffer)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
889 (Assert (eq (char-before (point-marker) (current-buffer)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
890 (Assert (eq (char-after) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
891 (Assert (eq (char-after (point)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
892 (Assert (eq (char-after (point-marker)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
893 (Assert (eq (char-after (point) (current-buffer)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
894 (Assert (eq (char-after (point-marker) (current-buffer)) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
895 (Assert (eq (preceding-char) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
896 (Assert (eq (preceding-char (current-buffer)) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
897 (Assert (eq (following-char) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
898 (Assert (eq (following-char (current-buffer)) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
899 (insert "foobar")
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
900 (Assert (eq (char-before) ?r))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
901 (Assert (eq (char-after) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
902 (Assert (eq (preceding-char) ?r))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
903 (Assert (eq (following-char) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
904 (goto-char (point-min))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
905 (Assert (eq (char-before) nil))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
906 (Assert (eq (char-after) ?f))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
907 (Assert (eq (preceding-char) 0))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
908 (Assert (eq (following-char) ?f))
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 428
diff changeset
909 )
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
910
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
911 ;;-----------------------------------------------------
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
912 ;; Test plist manipulation functions.
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
913 ;;-----------------------------------------------------
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
914 (let ((sym (make-symbol "test-symbol")))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
915 (Assert (eq t (get* sym t t)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
916 (Assert (eq t (get sym t t)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
917 (Assert (eq t (getf nil t t)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
918 (Assert (eq t (plist-get nil t t)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
919 (put sym 'bar 'baz)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
920 (Assert (eq 'baz (get sym 'bar)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
921 (Assert (eq 'baz (getf '(bar baz) 'bar)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
922 (Assert (eq 'baz (getf (symbol-plist sym) 'bar)))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
923 (Assert (eq 2 (getf '(1 2) 1)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
924 (Assert (eq 4 (put sym 3 4)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
925 (Assert (eq 4 (get sym 3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
926 (Assert (eq t (remprop sym 3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
927 (Assert (eq nil (remprop sym 3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
928 (Assert (eq 5 (get sym 3 5)))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
929 )
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
930
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
931 (loop for obj in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
932 (list (make-symbol "test-symbol")
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
933 "test-string"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
934 (make-extent nil nil nil)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
935 (make-face 'test-face))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
936 do
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 (Assert (eq 2 (get obj ?1 2)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
938 (Assert (eq 4 (put obj ?3 4)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 (Assert (eq 4 (get obj ?3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 (when (or (stringp obj) (symbolp obj))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 (Assert (equal '(?3 4) (object-plist obj))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 (Assert (eq t (remprop obj ?3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 (when (or (stringp obj) (symbolp obj))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944 (Assert (eq '() (object-plist obj))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 (Assert (eq nil (remprop obj ?3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 (when (or (stringp obj) (symbolp obj))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 (Assert (eq '() (object-plist obj))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 (Assert (eq 5 (get obj ?3 5)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 )
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 (Check-Error-Message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 error "Object type has no properties"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953 (get 2 'property))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 (Check-Error-Message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
956 error "Object type has no settable properties"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
957 (put (current-buffer) 'property 'value))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
958
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
959 (Check-Error-Message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
960 error "Object type has no removable properties"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
961 (remprop ?3 'property))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
962
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
963 (Check-Error-Message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
964 error "Object type has no properties"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
965 (object-plist (symbol-function 'car)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
966
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
967 (Check-Error-Message
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
968 error "Can't remove property from object"
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
969 (remprop (make-extent nil nil nil) 'detachable))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
970
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
971 ;;-----------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
972 ;; Test subseq
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
973 ;;-----------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
974 (Assert (equal (subseq nil 0) nil))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
975 (Assert (equal (subseq [1 2 3] 0) [1 2 3]))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
976 (Assert (equal (subseq [1 2 3] 1 -1) [2]))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
977 (Assert (equal (subseq "123" 0) "123"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
978 (Assert (equal (subseq "1234" -3 -1) "23"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
979 (Assert (equal (subseq #*0011 0) #*0011))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
980 (Assert (equal (subseq #*0011 -3 3) #*01))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
981 (Assert (equal (subseq '(1 2 3) 0) '(1 2 3)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
982 (Assert (equal (subseq '(1 2 3 4) -3 nil) '(2 3 4)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
983
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
984 (Check-Error wrong-type-argument (subseq 3 2))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
985 (Check-Error args-out-of-range (subseq [1 2 3] -42))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
986 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
988 ;;-----------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
989 ;; Time-related tests
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
990 ;;-----------------------------------------------------
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991 (Assert (= (length (current-time-string)) 24))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
992
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
993 ;;-----------------------------------------------------
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
994 ;; format test
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
995 ;;-----------------------------------------------------
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
996 (Assert (string= (format "%d" 10) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
997 (Assert (string= (format "%o" 8) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
998 (Assert (string= (format "%x" 31) "1f"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
999 (Assert (string= (format "%X" 31) "1F"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1000 ;; MS-Windows uses +002 in its floating-point numbers. #### We should
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1001 ;; perhaps fix this, but writing our own floating-point support in doprnt.c
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1002 ;; is very hard.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1003 (Assert (or (string= (format "%e" 100) "1.000000e+02")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1004 (string= (format "%e" 100) "1.000000e+002")))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1005 (Assert (or (string= (format "%E" 100) "1.000000E+02")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1006 (string= (format "%E" 100) "1.000000E+002")))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1007 (Assert (or (string= (format "%E" 100) "1.000000E+02")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1008 (string= (format "%E" 100) "1.000000E+002")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1009 (Assert (string= (format "%f" 100) "100.000000"))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1010 (Assert (string= (format "%7.3f" 12.12345) " 12.123"))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1011 (Assert (string= (format "%07.3f" 12.12345) "012.123"))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1012 (Assert (string= (format "%-7.3f" 12.12345) "12.123 "))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1013 (Assert (string= (format "%-07.3f" 12.12345) "12.123 "))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1014 (Assert (string= (format "%g" 100.0) "100"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1015 (Assert (or (string= (format "%g" 0.000001) "1e-06")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1016 (string= (format "%g" 0.000001) "1e-006")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1017 (Assert (string= (format "%g" 0.0001) "0.0001"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1018 (Assert (string= (format "%G" 100.0) "100"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1019 (Assert (or (string= (format "%G" 0.000001) "1E-06")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1020 (string= (format "%G" 0.000001) "1E-006")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1021 (Assert (string= (format "%G" 0.0001) "0.0001"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1022
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1023 (Assert (string= (format "%2$d%1$d" 10 20) "2010"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1024 (Assert (string= (format "%-d" 10) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1025 (Assert (string= (format "%-4d" 10) "10 "))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1026 (Assert (string= (format "%+d" 10) "+10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1027 (Assert (string= (format "%+d" -10) "-10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1028 (Assert (string= (format "%+4d" 10) " +10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1029 (Assert (string= (format "%+4d" -10) " -10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1030 (Assert (string= (format "% d" 10) " 10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1031 (Assert (string= (format "% d" -10) "-10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1032 (Assert (string= (format "% 4d" 10) " 10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1033 (Assert (string= (format "% 4d" -10) " -10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1034 (Assert (string= (format "%0d" 10) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1035 (Assert (string= (format "%0d" -10) "-10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1036 (Assert (string= (format "%04d" 10) "0010"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1037 (Assert (string= (format "%04d" -10) "-010"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1038 (Assert (string= (format "%*d" 4 10) " 10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1039 (Assert (string= (format "%*d" 4 -10) " -10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1040 (Assert (string= (format "%*d" -4 10) "10 "))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1041 (Assert (string= (format "%*d" -4 -10) "-10 "))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1042 (Assert (string= (format "%#d" 10) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1043 (Assert (string= (format "%#o" 8) "010"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1044 (Assert (string= (format "%#x" 16) "0x10"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1045 (Assert (or (string= (format "%#e" 100) "1.000000e+02")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1046 (string= (format "%#e" 100) "1.000000e+002")))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1047 (Assert (or (string= (format "%#E" 100) "1.000000E+02")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1048 (string= (format "%#E" 100) "1.000000E+002")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1049 (Assert (string= (format "%#f" 100) "100.000000"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1050 (Assert (string= (format "%#g" 100.0) "100.000"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1051 (Assert (or (string= (format "%#g" 0.000001) "1.00000e-06")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1052 (string= (format "%#g" 0.000001) "1.00000e-006")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1053 (Assert (string= (format "%#g" 0.0001) "0.000100000"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1054 (Assert (string= (format "%#G" 100.0) "100.000"))
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1055 (Assert (or (string= (format "%#G" 0.000001) "1.00000E-06")
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 464
diff changeset
1056 (string= (format "%#G" 0.000001) "1.00000E-006")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1057 (Assert (string= (format "%#G" 0.0001) "0.000100000"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1058 (Assert (string= (format "%.1d" 10) "10"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1059 (Assert (string= (format "%.4d" 10) "0010"))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1060 ;; Combination of `-', `+', ` ', `0', `#', `.', `*'
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1061 (Assert (string= (format "%-04d" 10) "10 "))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1062 (Assert (string= (format "%-*d" 4 10) "10 "))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1063 ;; #### Correctness of this behavior is questionable.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1064 ;; It might be better to signal error.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1065 (Assert (string= (format "%-*d" -4 10) "10 "))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1066 ;; These behavior is not specified.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1067 ;; (format "%-+d" 10)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1068 ;; (format "%- d" 10)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1069 ;; (format "%-01d" 10)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1070 ;; (format "%-#4x" 10)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1071 ;; (format "%-.1d" 10)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1072
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1073 (Assert (string= (format "%01.1d" 10) "10"))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1074 (Assert (string= (format "%03.1d" 10) " 10"))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1075 (Assert (string= (format "%01.3d" 10) "010"))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1076 (Assert (string= (format "%1.3d" 10) "010"))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1077 (Assert (string= (format "%3.1d" 10) " 10"))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1078
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1079 ;;; The following two tests used to use 1000 instead of 100,
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1080 ;;; but that merely found buffer overflow bugs in Solaris sprintf().
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1081 (Assert (= 102 (length (format "%.100f" 3.14))))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1082 (Assert (= 100 (length (format "%100f" 3.14))))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1083
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1084 ;;; Check for 64-bit cleanness on LP64 platforms.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1085 (Assert (= (read (format "%d" most-positive-fixnum)) most-positive-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1086 (Assert (= (read (format "%ld" most-positive-fixnum)) most-positive-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1087 (Assert (= (read (format "%u" most-positive-fixnum)) most-positive-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1088 (Assert (= (read (format "%lu" most-positive-fixnum)) most-positive-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1089 (Assert (= (read (format "%d" most-negative-fixnum)) most-negative-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1090 (Assert (= (read (format "%ld" most-negative-fixnum)) most-negative-fixnum))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1091
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1092 ;;; "%u" is undocumented, and Emacs Lisp has no unsigned type.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1093 ;;; What to do if "%u" is used with a negative number?
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1094 ;;; The most reasonable thing seems to be to print an un-read-able number.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1095 ;;; The printed value might be useful to a human, if not to Emacs Lisp.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1096 (Check-Error invalid-read-syntax (read (format "%u" most-negative-fixnum)))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
1097 (Check-Error invalid-read-syntax (read (format "%u" -1)))
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1098
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1099 ;; Check all-completions ignore element start with space.
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1100 (Assert (not (all-completions "" '((" hidden" . "object")))))
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 446
diff changeset
1101 (Assert (all-completions " " '((" hidden" . "object"))))