dispatch-macro-characters.lsp 2.29 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Feb  5 11:42:24 2005
;;;; Contains: Tests of dispatch macro character functions

(in-package :cl-test)

(deftest make-dispatch-macro-character.1
  (with-standard-io-syntax
   (let* ((*readtable* (copy-readtable nil))
sds's avatar
sds committed
11
          (*package* (find-package "CL-TEST")))
12
13
14
15
16
17
18
19
     (values
      (make-dispatch-macro-character #\!)
      (read-from-string "123!"))))
  t 123)

(deftest make-dispatch-macro-character.2
  (with-standard-io-syntax
   (let* ((*readtable* (copy-readtable nil))
sds's avatar
sds committed
20
          (*package* (find-package "CL-TEST")))
21
22
23
24
25
26
27
28
     (values
      (make-dispatch-macro-character #\! t)
      (read-from-string "123!"))))
  t 123!)

(deftest make-dispatch-macro-character.3
  (with-standard-io-syntax
   (let* ((*readtable* (copy-readtable nil))
sds's avatar
sds committed
29
          (*package* (find-package "CL-TEST")))
30
31
32
     (values
      (make-dispatch-macro-character #\!)
      (loop for c across +standard-chars+
sds's avatar
sds committed
33
34
35
36
37
38
            for result = (handler-case
                          (read-from-string (coerce (list #\! c #\X) 'string))
                          (reader-error (c) :good)
                          (error (c) :bad))
            unless (eql result :good)
            collect (list c result)))))
39
40
41
42
43
  t nil)

(deftest make-dispatch-macro-character.4
  (with-standard-io-syntax
   (let* ((rt (copy-readtable nil))
sds's avatar
sds committed
44
          (*package* (find-package "CL-TEST")))
45
46
47
48
     (values
      (make-dispatch-macro-character #\! t rt)
      (read-from-string "!")
      (let ((*readtable* rt))
sds's avatar
sds committed
49
        (read-from-string "123!")))))
50
51
52
53
54
55
56
57
58
59
  t ! 123!)

(deftest make-dispatch-macro-character.error.1
  (let ((*readtable* (copy-readtable nil)))
    (signals-error (make-dispatch-macro-character) program-error))
  t)

(deftest make-dispatch-macro-character.error.2
  (let ((*readtable* (copy-readtable nil)))
    (signals-error (make-dispatch-macro-character #\! t *readtable* nil)
sds's avatar
sds committed
60
                   program-error))
61
62
63
64
65
66
  t)

;;; GET-DISPATCH-MACRO-CHARACTER

(deftest get-dispatch-macro-character.1
  (loop for c across +standard-chars+
sds's avatar
sds committed
67
68
69
70
71
72
73
        when (and (not (eql c #\#))
                          (handler-case
                           (list
                             (get-dispatch-macro-character c #\a)
                             c)
                           (error (cnd) nil)))
        collect it)
74
75
76
77
  nil)



sds's avatar
sds committed
78