Mercurial > hg > xemacs-beta
annotate tests/automated/symbol-tests.el @ 5605:cc7f8a0e569a
Accept bignums unambiguously in the syntax for object labels, lread.c.
src/ChangeLog addition:
2011-12-03 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (read1):
Don't wrap when reading expressions that use bignums as object
labels, that can lead to ambiguity and it's not actually that hard
to use parse_integer() to avoid it.
tests/ChangeLog addition:
2011-12-03 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-reader-tests.el:
Check that integer object labels (using the #N=... syntax) treat
bignums as such, rather than as fixnums that have wrapped.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 03 Dec 2011 15:13:55 +0000 |
| 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 |