1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Feb 23 04:41:29 2004
;;;; Contains: Tests of COPY-PPRINT-DISPATCH
(in-package :cl-test)
(deftest copy-pprint-dispatch.1
(with-standard-io-syntax
(let ((obj '(foo bar))
(*package* (find-package :cl-test))
(*print-readably* nil)
(*print-pretty* t))
(values
(prin1-to-string obj)
(let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
(set-pprint-dispatch
`(eql ,obj)
#'(lambda (s obj2) (let ((*print-pretty* nil))
(format s "#.'~S" obj2))))
(prin1-to-string obj))
(prin1-to-string obj))))
"(FOO BAR)"
"#.'(FOO BAR)"
"(FOO BAR)")
(deftest copy-pprint-dispatch.2
(with-standard-io-syntax
(let ((obj '(foo bar))
(*package* (find-package :cl-test))
(*print-readably* nil)
(*print-pretty* t))
(values
(prin1-to-string obj)
(let ((*print-pprint-dispatch* (copy-pprint-dispatch
*print-pprint-dispatch*)))
(set-pprint-dispatch
`(eql ,obj)
#'(lambda (s obj2) (let ((*print-pretty* nil))
(format s "#.'~S" obj2))))
(prin1-to-string obj))
(prin1-to-string obj))))
"(FOO BAR)"
"#.'(FOO BAR)"
"(FOO BAR)")
(deftest copy-pprint-dispatch.3
(with-standard-io-syntax
(let ((obj '(foo bar))
(*package* (find-package :cl-test))
(*print-readably* nil)
(*print-pretty* t))
(values
(prin1-to-string obj)
(let ((*print-pprint-dispatch* (copy-pprint-dispatch nil)))
(set-pprint-dispatch
`(eql ,obj)
#'(lambda (s obj2) (let ((*print-pretty* nil))
(format s "#.'~S" obj2))))
(prin1-to-string obj))
(prin1-to-string obj))))
"(FOO BAR)"
"#.'(FOO BAR)"
"(FOO BAR)")
(deftest copy-pprint-dispatch.4
(with-standard-io-syntax
(let ((obj '(foo bar))
(*package* (find-package :cl-test))
(*print-readably* nil)
(*print-pretty* t))
(values
(prin1-to-string obj)
(let ((table (copy-pprint-dispatch)))
(set-pprint-dispatch
`(eql ,obj)
#'(lambda (s obj2) (let ((*print-pretty* nil))
(format s "#.'~S" obj2)))
0
table)
(let ((*print-pprint-dispatch* (copy-pprint-dispatch table)))
(prin1-to-string obj)))
(prin1-to-string obj))))
"(FOO BAR)"
"#.'(FOO BAR)"
"(FOO BAR)")
(deftest copy-pprint-dispatch.5
(let ((new-table (copy-pprint-dispatch)))
(values
(eql new-table *print-pprint-dispatch*)
(member new-table *universe*)))
nil nil)
(deftest copy-pprint-dispatch.6
(let ((new-table (copy-pprint-dispatch *print-pprint-dispatch*)))
(values
(eql new-table *print-pprint-dispatch*)
(member new-table *universe*)))
nil nil)
(deftest copy-pprint-dispatch.7
(let ((new-table (copy-pprint-dispatch nil)))
(values
(eql new-table *print-pprint-dispatch*)
(member new-table *universe*)))
nil nil)
(deftest copy-pprint-dispatch.8
(let* ((table1 (copy-pprint-dispatch))
(table2 (copy-pprint-dispatch table1)))
(eql table1 table2))
nil)
;;; Error tests
(deftest copy-pprint-dispatch.error.1
(signals-error (copy-pprint-dispatch nil nil) program-error)
t)
(deftest copy-pprint-dispatch.error.2
(check-type-error #'copy-pprint-dispatch #'null)
nil)
|
