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