Mercurial > hg > xemacs-beta

comparison tests/automated/symbol-tests.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
1 ;; Copyright (C) 1999 Free Software Foundation, Inc. 1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
2 2
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> 3 ;; Author: Hrvoje Niksic <hniksic@srce.hr>
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> 4 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
5 ;; Created: 1999 5 ;; Created: 1999
6 ;; Keywords: tests 6 ;; Keywords: tests
7 7
8 ;; This file is part of XEmacs. 8 ;; This file is part of XEmacs.
9 9
248 248
249 ;;----------------------------------------------------- 249 ;;-----------------------------------------------------
250 ;; Magic symbols 250 ;; Magic symbols
251 ;;----------------------------------------------------- 251 ;;-----------------------------------------------------
252 252
253 ;; Magic symbols are only half implemented. However, a subset of the 253 ;; Magic symbols are almost totally unimplemented. However, a
254 ;; functionality is being used to implement backward compatibility or 254 ;; rudimentary subset of the functionality is being used to implement
255 ;; clearer error messages for new features such as specifiers and 255 ;; backward compatibility or clearer error messages for new features
256 ;; glyphs. These tests try to test that working subset. 256 ;; such as specifiers and glyphs. These tests try to test that
257 257 ;; working subset.
258 (let ((mysym (make-symbol "test-symbol")) 258
259 save) 259 (let ((mysym (make-symbol "test-symbol")))
260 (dontusethis-set-symbol-value-handler 260 (dontusethis-set-symbol-value-handler
261 mysym 261 mysym
262 'set-value 262 'set-value
263 (lambda (&rest args) 263 (lambda (&rest args)
264 (throw 'test-tag args))) 264 (throw 'test-tag args)))
265 (Assert (not (boundp mysym)))
266 (Assert (equal (catch 'test-tag 265 (Assert (equal (catch 'test-tag
267 (set mysym 'foo)) 266 (set mysym 'foo))
268 `(,mysym (foo) set nil nil))) 267 `(,mysym (foo) set nil nil))))
269 (Assert (not (boundp mysym))) 268
270 (dontusethis-set-symbol-value-handler 269 ;; #### These two make XEmacs crash!
271 mysym 270
272 'set-value 271 ;(let ((mysym (make-symbol "test-symbol")))
273 (lambda (&rest args) (setq save (nth 1 args)))) 272 ; (dontusethis-set-symbol-value-handler
274 (set mysym 'foo) 273 ; mysym
275 (Assert (equal save '(foo))) 274 ; 'make-unbound
276 (Assert (eq (symbol-value mysym) 'foo)) 275 ; (lambda (&rest args)
277 ) 276 ; (throw 'test-tag args)))
278 277 ; (Assert (equal (catch 'test-tag
279 (let ((mysym (make-symbol "test-symbol")) 278 ; (set mysym 'foo))
280 save) 279 ; `(,mysym (foo) set nil nil))))
281 (dontusethis-set-symbol-value-handler
282 mysym
283 'make-unbound
284 (lambda (&rest args)
285 (throw 'test-tag args)))
286 (Assert (equal (catch 'test-tag
287 (makunbound mysym))
288 `(,mysym nil makunbound nil nil)))
289 (dontusethis-set-symbol-value-handler
290 mysym
291 'make-unbound
292 (lambda (&rest args) (setq save (nth 2 args))))
293 (Assert (not (boundp mysym)))
294 (set mysym 'bar)
295 (Assert (null save))
296 (Assert (eq (symbol-value mysym) 'bar))
297 (makunbound mysym)
298 (Assert (not (boundp mysym)))
299 (Assert (eq save 'makunbound))
300 )
301
302 (when (featurep 'file-coding)
303 (Assert (eq pathname-coding-system file-name-coding-system))
304 (let ((val1 file-name-coding-system)
305 (val2 pathname-coding-system))
306 (Assert (eq val1 val2))
307 (let ((file-name-coding-system 'no-conversion-dos))
308 (Assert (eq file-name-coding-system 'no-conversion-dos))
309 (Assert (eq pathname-coding-system file-name-coding-system)))
310 (let ((pathname-coding-system 'no-conversion-mac))
311 (Assert (eq file-name-coding-system 'no-conversion-mac))
312 (Assert (eq pathname-coding-system file-name-coding-system)))
313 (Assert (eq file-name-coding-system pathname-coding-system))
314 (Assert (eq val1 file-name-coding-system)))
315 (Assert (eq pathname-coding-system file-name-coding-system)))
316
317 280
318 ;(let ((mysym (make-symbol "test-symbol"))) 281 ;(let ((mysym (make-symbol "test-symbol")))
319 ; (dontusethis-set-symbol-value-handler 282 ; (dontusethis-set-symbol-value-handler
320 ; mysym 283 ; mysym
321 ; 'make-local 284 ; 'make-local
322 ; (lambda (&rest args) 285 ; (lambda (&rest args)
323 ; (throw 'test-tag args))) 286 ; (throw 'test-tag args)))
324 ; (Assert (equal (catch 'test-tag 287 ; (Assert (equal (catch 'test-tag
325 ; (set mysym 'foo)) 288 ; (set mysym 'foo))
326 ; `(,mysym (foo) make-local nil nil)))) 289 ; `(,mysym (foo) set nil nil))))