Mercurial > hg > xemacs-beta
annotate tests/automated/symbol-tests.el @ 5652:cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
lisp/ChangeLog addition:
2012-05-01 Aidan Kehoe <kehoea@parhasard.net>
Avoid #'delq in core code, for the sake of style and a (very
slightly) smaller binary.
* behavior.el (disable-behavior):
* behavior.el (compute-behavior-group-children):
* buff-menu.el (buffers-tab-items):
* byte-optimize.el (byte-optimize-delay-constants-math):
* byte-optimize.el (byte-optimize-logmumble):
* byte-optimize.el (byte-decompile-bytecode-1):
* byte-optimize.el (byte-optimize-lapcode):
* bytecomp.el:
* bytecomp.el (byte-compile-arglist-warn):
* bytecomp.el (byte-compile-warn-about-unresolved-functions):
* bytecomp.el (byte-compile-lambda):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-insert):
* bytecomp.el (byte-compile-defalias-warn):
* cl-macs.el (cl-upcase-arg):
* cl-macs.el (cl-transform-lambda):
* cl-macs.el (cl-do-proclaim):
* cl-macs.el (defstruct):
* cl-macs.el (cl-make-type-test):
* cl-macs.el (define-compiler-macro):
* cl-macs.el (delete-duplicates):
* cus-edit.el (widget-face-value-delete):
* cus-edit.el (face-history):
* easymenu.el (easy-menu-remove):
* files.el (files-fetch-hook-value):
* files.el (file-expand-wildcards):
* font-lock.el (font-lock-update-removed-keyword-alist):
* font-lock.el (font-lock-remove-keywords):
* frame.el (frame-initialize):
* frame.el (frame-notice-user-settings):
* frame.el (set-frame-font):
* frame.el (delete-other-frames):
* frame.el (get-frame-for-buffer-noselect):
* gnuserv.el (gnuserv-kill-buffer-function):
* gnuserv.el (gnuserv-check-device):
* gnuserv.el (gnuserv-kill-client):
* gnuserv.el (gnuserv-buffer-done-1):
* gtk-font-menu.el (gtk-reset-device-font-menus):
* gutter-items.el (buffers-tab-items):
* gutter.el (set-gutter-element-visible-p):
* info.el (Info-find-file-node):
* info.el (Info-history-add):
* info.el (Info-build-annotation-completions):
* info.el (Info-index):
* info.el (Info-reannotate-node):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* lib-complete.el (lib-complete:cache-completions):
* loadhist.el (unload-feature):
* menubar-items.el (build-buffers-menu-internal):
* menubar.el (delete-menu-item):
* menubar.el (relabel-menu-item):
* msw-font-menu.el (mswindows-reset-device-font-menus):
* mule/make-coding-system.el (fixed-width-generate-helper):
* next-error.el (next-error-find-buffer):
* obsolete.el:
* obsolete.el (find-non-ascii-charset-string):
* obsolete.el (find-non-ascii-charset-region):
* occur.el (multi-occur-by-filename-regexp):
* occur.el (occur-1):
* packages.el (packages-package-hierarchy-directory-names):
* packages.el (package-get-key-1):
* process.el (setenv):
* simple.el (undo):
* simple.el (handle-pre-motion-command-current-command-is-motion):
* sound.el (load-sound-file):
* wid-edit.el (widget-field-value-delete):
* wid-edit.el (widget-checklist-match-inline):
* wid-edit.el (widget-checklist-match-find):
* wid-edit.el (widget-editable-list-delete-at):
* wid-edit.el (widget-editable-list-entry-create):
* window.el (quit-window):
* x-font-menu.el (x-reset-device-font-menus-core):
1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...)
forms; this is in non-dumped files, it was done previously in
dumped files.
2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR),
where #'eq and #'eql are equivalent
3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not
a non-fixnum number. Saves a little space in the dumped file
(since the compiler macro adds :test #'eq to the delete* call if
it's not clear that FOO is not a non-fixnum number).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Tue, 01 May 2012 16:17:42 +0100 |
parents | 071b810ceb18 |
children |
rev | line source |
---|---|
428 | 1 ;; Copyright (C) 1999 Free Software Foundation, Inc. |
2 | |
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> | |
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> | |
5 ;; Created: 1999 | |
6 ;; Keywords: tests | |
7 | |
8 ;; This file is part of XEmacs. | |
9 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; option) any later version. |
428 | 14 |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; for more details. |
428 | 19 |
20 ;; You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
428 | 22 |
23 ;;; Synched up with: Not in FSF. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Test symbols operations. | |
28 ;; See test-harness.el for instructions on how to run these tests. | |
29 | |
30 (eval-when-compile | |
31 (condition-case nil | |
32 (require 'test-harness) | |
33 (file-error | |
34 (push "." load-path) | |
35 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
36 (push (file-name-directory load-file-name) load-path)) | |
37 (require 'test-harness)))) | |
38 | |
39 | |
40 (defun ts-fresh-symbol-name (name) | |
41 "Return a variant of NAME (a string) that is not interned." | |
42 (when (intern-soft name) | |
43 (let ((count 1) | |
44 (orig name)) | |
45 (while (progn | |
46 (setq name (format "%s-%d" orig count)) | |
47 (intern-soft name)) | |
48 (incf count)))) | |
49 name) | |
50 | |
51 ;;----------------------------------------------------- | |
52 ;; Creating, reading, and printing symbols | |
53 ;;----------------------------------------------------- | |
54 | |
55 (dolist (name '("foo" "bar" "" | |
56 "something with space in it" | |
57 "a string with \0 in the middle." | |
58 "100" "10.0" "#<>[]]]];'\\';" | |
59 "!@#$%^^&*(()__")) | |
60 (let ((interned (intern name)) | |
61 (uninterned (make-symbol name))) | |
62 (Assert (symbolp interned)) | |
63 (Assert (symbolp uninterned)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
64 (Assert (equal (symbol-name interned) name)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
65 (Assert (equal (symbol-name uninterned) name)) |
428 | 66 (Assert (not (eq interned uninterned))) |
67 (Assert (not (equal interned uninterned))))) | |
68 | |
5576
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
69 (labels ((check-weak-list-unique (weak-list &optional reversep) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
70 "Check that elements of WEAK-LIST are referenced only there." |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
71 (let ((len (length (weak-list-list weak-list)))) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
72 (if (string-match "Using the new GC algorithms." |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
73 Installation-string) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
74 (Implementation-Incomplete-Expect-Failure |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
75 (Assert (not (zerop len))) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
76 (garbage-collect) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
77 (Assert (eq (length (weak-list-list weak-list)) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
78 (if (not reversep) 0 len)))) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
79 (Assert (not (zerop len))) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
80 (garbage-collect) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
81 (Assert (eq (length (weak-list-list weak-list)) |
071b810ceb18
Declare labels as line where appropriate; use #'labels, not #'flet, tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5560
diff
changeset
|
82 (if (not reversep) 0 len))))))) |
428 | 83 (let ((weak-list (make-weak-list)) |
84 (gc-cons-threshold most-positive-fixnum)) | |
85 ;; Symbols created with `make-symbol' and `gensym' should be fresh | |
86 ;; and not referenced anywhere else. We check that no other | |
87 ;; references are available using a weak list. | |
88 (eval | |
89 ;; This statement must not be run byte-compiled, or the values | |
90 ;; remain referenced on the bytecode interpreter stack. | |
91 '(set-weak-list-list weak-list (list (make-symbol "foo") (gensym "foo")))) | |
92 (check-weak-list-unique weak-list) | |
93 | |
94 ;; Equivalent test for `intern' and `gentemp'. | |
95 (eval | |
96 '(set-weak-list-list weak-list | |
97 (list (intern (ts-fresh-symbol-name "foo")) | |
98 (gentemp (ts-fresh-symbol-name "bar"))))) | |
99 (check-weak-list-unique weak-list 'not))) | |
100 | |
101 (Assert (not (intern-soft (make-symbol "foo")))) | |
102 (Assert (not (intern-soft (gensym "foo")))) | |
103 (Assert (intern-soft (intern (ts-fresh-symbol-name "foo")))) | |
104 (Assert (intern-soft (gentemp (ts-fresh-symbol-name "bar")))) | |
105 | |
106 ;; Reading a symbol should intern it automatically, unless the symbol | |
107 ;; is marked specially. | |
108 (dolist (string (mapcar #'ts-fresh-symbol-name '("foo" "bar" "\\\0\\\1"))) | |
109 (setq symbol (read string) | |
110 string (read (concat "\"" string "\""))) | |
111 (Assert (intern-soft string)) | |
112 (Assert (intern-soft symbol)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
113 (Assert (eq (intern-soft string) (intern-soft symbol)))) |
428 | 114 |
115 (let ((fresh (read (concat "#:" (ts-fresh-symbol-name "foo"))))) | |
116 (Assert (not (intern-soft fresh)))) | |
117 | |
118 ;; Check #N=OBJECT and #N# read syntax. | |
119 (let* ((list (read "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")) | |
120 (foo (nth 0 list)) | |
121 (foo2 (nth 1 list)) | |
122 (bar (nth 2 list)) | |
123 (bar2 (nth 3 list)) | |
124 (foo3 (nth 4 list)) | |
125 (bar3 (nth 5 list))) | |
126 (Assert (symbolp foo)) | |
127 (Assert (not (intern-soft foo))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
128 (Assert (equal (symbol-name foo) "foo")) |
428 | 129 (Assert (symbolp bar)) |
130 (Assert (not (intern-soft bar))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
131 (Assert (equal (symbol-name bar) "bar")) |
428 | 132 |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
133 (Assert (eq foo foo2)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
134 (Assert (eq foo2 foo3)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
135 (Assert (eq bar bar2)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
136 (Assert (eq bar2 bar3))) |
428 | 137 |
138 ;; Check #N=OBJECT and #N# print syntax. | |
139 (let* ((foo (make-symbol "foo")) | |
140 (bar (make-symbol "bar")) | |
141 (list (list foo foo bar bar foo bar))) | |
142 (let* ((print-gensym nil) | |
143 (printed-list (prin1-to-string list))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
144 (Assert (equal printed-list "(foo foo bar bar foo bar)"))) |
428 | 145 (let* ((print-gensym t) |
5560
58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
146 (print-continuous-numbering t) |
428 | 147 (printed-list (prin1-to-string list))) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
148 (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)")))) |
428 | 149 |
150 ;;----------------------------------------------------- | |
151 ;; Read-only symbols | |
152 ;;----------------------------------------------------- | |
153 | |
154 (Check-Error setting-constant | |
155 (set nil nil)) | |
156 (Check-Error setting-constant | |
157 (set t nil)) | |
158 | |
159 ;;----------------------------------------------------- | |
160 ;; Variable indirections | |
161 ;;----------------------------------------------------- | |
162 | |
163 (let ((foo 0) | |
164 (bar 1)) | |
165 (defvaralias 'foo 'bar) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
166 (Assert (eq foo bar)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
167 (Assert (eq foo 1)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
168 (Assert (eq (variable-alias 'foo) 'bar)) |
428 | 169 (defvaralias 'bar 'foo) |
170 (Check-Error cyclic-variable-indirection | |
171 (symbol-value 'foo)) | |
172 (Check-Error cyclic-variable-indirection | |
173 (symbol-value 'bar)) | |
174 (defvaralias 'foo nil) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
175 (Assert (eq foo 0)) |
428 | 176 (defvaralias 'bar nil) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
177 (Assert (eq bar 1))) |
428 | 178 |
179 ;;----------------------------------------------------- | |
180 ;; Keywords | |
181 ;;----------------------------------------------------- | |
182 | |
183 ;;; Reading keywords | |
184 | |
185 ;; In Elisp, a keyword is by definition a symbol beginning with `:' | |
186 ;; that is interned in the global obarray. | |
187 | |
188 ;; In Elisp, a keyword is interned as any other symbol. | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
189 (Assert (eq (read ":foo") (intern ":foo"))) |
428 | 190 |
191 ;; A keyword is self-quoting and evaluates to itself. | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
192 (Assert (eq (eval (intern ":foo")) :foo)) |
428 | 193 |
194 ;; Keywords are recognized as such only if interned in the global | |
195 ;; obarray, and `keywordp' is aware of that. | |
196 (Assert (keywordp :foo)) | |
197 (Assert (not (keywordp (intern ":foo" [0])))) | |
198 | |
199 ;; Keywords used to be initialized at read-time, which resulted in | |
200 ;; (symbol-value (intern ":some-new-keyword")) signaling an error. | |
201 ;; Now we handle keywords at the time when the symbol is interned, so | |
202 ;; that (intern ":something) and (read ":something) will be | |
203 ;; equivalent. These tests check various operations on symbols that | |
204 ;; are guaranteed to be freshly interned. | |
205 | |
206 ;; Interning a fresh keyword string should produce a regular | |
207 ;; keyword. | |
208 (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) | |
209 (fresh-keyword (intern fresh-keyword-name))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
210 (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) |
428 | 211 (Assert (keywordp fresh-keyword))) |
212 | |
213 ;; Likewise, reading a fresh keyword string should produce a regular | |
214 ;; keyword. | |
215 (let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo")) | |
216 (fresh-keyword (read fresh-keyword-name))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
217 (Assert (eq (symbol-value fresh-keyword) fresh-keyword)) |
428 | 218 (Assert (keywordp fresh-keyword))) |
219 | |
220 ;;; Assigning to keywords | |
221 | |
222 ;; You shouldn't be able to set its value to something bogus. | |
223 (Check-Error setting-constant | |
224 (set :foo 5)) | |
225 | |
226 ;; But, for backward compatibility, setting to the same value is OK. | |
227 (Assert | |
228 (eq (set :foo :foo) :foo)) | |
229 | |
230 ;; Playing games with `intern' shouldn't fool us. | |
231 (Check-Error setting-constant | |
232 (set (intern ":foo" obarray) 5)) | |
233 (Assert | |
234 (eq (set (intern ":foo" obarray) :foo) :foo)) | |
235 | |
236 ;; But symbols not interned in the global obarray are not real | |
237 ;; keywords (in elisp): | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
238 (Assert (eq (set (intern ":foo" [0]) 5) 5)) |
428 | 239 |
240 ;;; Printing keywords | |
241 | |
242 (let ((print-gensym t)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
243 (Assert (equal (prin1-to-string :foo) ":foo")) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
244 (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
245 (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo"))) |
428 | 246 |
247 (let ((print-gensym nil)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
248 (Assert (equal (prin1-to-string :foo) ":foo")) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
249 (Assert (equal (prin1-to-string (intern ":foo")) ":foo")) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
250 (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo"))) |
428 | 251 |
252 ;; #### Add many more tests for printing and reading symbols, as well | |
253 ;; as print-gensym and print-gensym-alist! | |
254 | |
255 ;;----------------------------------------------------- | |
256 ;; Magic symbols | |
257 ;;----------------------------------------------------- | |
258 | |
440 | 259 ;; Magic symbols are only half implemented. However, a subset of the |
260 ;; functionality is being used to implement backward compatibility or | |
261 ;; clearer error messages for new features such as specifiers and | |
262 ;; glyphs. These tests try to test that working subset. | |
428 | 263 |
440 | 264 (let ((mysym (make-symbol "test-symbol")) |
265 save) | |
428 | 266 (dontusethis-set-symbol-value-handler |
267 mysym | |
268 'set-value | |
269 (lambda (&rest args) | |
270 (throw 'test-tag args))) | |
440 | 271 (Assert (not (boundp mysym))) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
272 (Assert (equal (catch 'test-tag |
428 | 273 (set mysym 'foo)) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
274 `(,mysym (foo) set nil nil))) |
440 | 275 (Assert (not (boundp mysym))) |
276 (dontusethis-set-symbol-value-handler | |
277 mysym | |
278 'set-value | |
279 (lambda (&rest args) (setq save (nth 1 args)))) | |
280 (set mysym 'foo) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
281 (Assert (equal save '(foo))) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
282 (Assert (eq (symbol-value mysym) 'foo)) |
440 | 283 ) |
428 | 284 |
440 | 285 (let ((mysym (make-symbol "test-symbol")) |
286 save) | |
287 (dontusethis-set-symbol-value-handler | |
288 mysym | |
289 'make-unbound | |
290 (lambda (&rest args) | |
291 (throw 'test-tag args))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
292 (Assert (equal (catch 'test-tag |
440 | 293 (makunbound mysym)) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
294 `(,mysym nil makunbound nil nil))) |
440 | 295 (dontusethis-set-symbol-value-handler |
296 mysym | |
297 'make-unbound | |
298 (lambda (&rest args) (setq save (nth 2 args)))) | |
299 (Assert (not (boundp mysym))) | |
300 (set mysym 'bar) | |
301 (Assert (null save)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
302 (Assert (eq (symbol-value mysym) 'bar)) |
440 | 303 (makunbound mysym) |
304 (Assert (not (boundp mysym))) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
305 (Assert (eq save 'makunbound)) |
440 | 306 ) |
307 | |
826 | 308 ;; pathname-coding-system is no more. |
309 ; (when (featurep 'file-coding) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
310 ; (Assert (eq pathname-coding-system file-name-coding-system)) |
826 | 311 ; (let ((val1 file-name-coding-system) |
312 ; (val2 pathname-coding-system)) | |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
313 ; (Assert (eq val1 val2)) |
826 | 314 ; (let ((file-name-coding-system 'no-conversion-dos)) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
315 ; (Assert (eq file-name-coding-system 'no-conversion-dos)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
316 ; (Assert (eq pathname-coding-system file-name-coding-system))) |
826 | 317 ; (let ((pathname-coding-system 'no-conversion-mac)) |
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
318 ; (Assert (eq file-name-coding-system 'no-conversion-mac)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
319 ; (Assert (eq pathname-coding-system file-name-coding-system))) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
320 ; (Assert (eq file-name-coding-system pathname-coding-system)) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
321 ; (Assert (eq val1 file-name-coding-system))) |
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
322 ; (Assert (eq pathname-coding-system file-name-coding-system))) |
440 | 323 |
428 | 324 |
325 ;(let ((mysym (make-symbol "test-symbol"))) | |
326 ; (dontusethis-set-symbol-value-handler | |
327 ; mysym | |
328 ; 'make-local | |
329 ; (lambda (&rest args) | |
330 ; (throw 'test-tag args))) | |
331 ; (Assert (equal (catch 'test-tag | |
332 ; (set mysym 'foo)) | |
440 | 333 ; `(,mysym (foo) make-local nil nil)))) |
4381
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
334 |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
335 ;; ---------------------------------------------------------------- |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
336 ;; Symbol documentation |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
337 ;; ---------------------------------------------------------------- |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
338 |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
339 ;; built-in variable documentation |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
340 (Assert (string= (built-in-symbol-file 'internal-doc-file-name) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
341 "doc.c")) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
342 |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
343 ;; built-in function documentation |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
344 (Assert (string= (built-in-symbol-file 'built-in-symbol-file) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
345 "doc.c")) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
346 |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
347 ;; built-in macro documentation |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
348 (Assert (string= (built-in-symbol-file 'when) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
349 "eval.c")) |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
350 |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
351 ;; #### we should handle symbols defined in Lisp, dumped, autoloaded, |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
352 ;; and required, too. |
3906442b491b
Improve style and add tests for 'built-in-symbol-file'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
1413
diff
changeset
|
353 |