source: trunk/source/tests/ansi-tests/set-macro-character.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 1.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Jan  3 10:37:16 2005
4;;;; Contains: Tests of SET-MACRO-CHARACTER
5
6(in-package :cl-test)
7
8(def-syntax-test set-macro-character.1
9  (let ((*readtable* (copy-readtable))
10        (*package* (find-package :cl-test)))
11    (let ((v1 (read-from-string "?!")))
12      (assert (eql v1 '?!))
13      (flet ((%f (stream char)
14                 (declare (ignore stream))
15                 (assert (eql char #\?))
16                 17))
17        (let ((fn #'%f))
18          (assert (equal (multiple-value-list
19                          (set-macro-character #\? fn nil))
20                         '(t)))
21          (values
22           (multiple-value-list (read-from-string "?!"))
23           (multiple-value-list (read-from-string "!?")))))))
24  (17 1)
25  (! 1))
26
27(def-syntax-test set-macro-character.2
28  (let ((rt (copy-readtable))
29        (*package* (find-package :cl-test)))
30    (let ((v1 (read-from-string "?!")))
31      (assert (eql v1 '?!))
32      (flet ((%f (stream char)
33                 (declare (ignore stream))
34                 (assert (eql char #\?))
35                 17))
36        (let ((fn #'%f))
37          (assert (equal (multiple-value-list
38                          (set-macro-character #\? fn t rt))
39                         '(t)))
40          (let ((*readtable* rt))
41            (values
42             (multiple-value-list (read-from-string "?!"))
43             (multiple-value-list (read-from-string "!?"))))))))
44  (17 1)
45  (!? 2))
46
47(defun set-macro-character.3-test-fn (stream char)
48  (declare (ignore stream))
49  (assert (eql char #\?))
50  :foo)
51
52(def-syntax-test set-macro-character.3
53  (let ((*readtable* (copy-readtable))
54        (*package* (find-package :cl-test)))
55    (let ((v1 (read-from-string "?!"))
56          (fn 'set-macro-character.3-test-fn))
57      (assert (eql v1 '?!))
58      (assert (equal (multiple-value-list
59                      (set-macro-character #\? fn nil))
60                     '(t)))
61      (values
62       (multiple-value-list (read-from-string "?!"))
63       (multiple-value-list (read-from-string "!?")))))
64  (:foo 1)
65  (! 1))
Note: See TracBrowser for help on using the repository browser.