source: trunk/source/tests/ansi-tests/print-level.lsp @ 8991

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

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

File size: 3.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Mon Jul 26 13:07:51 2004
4;;;; Contains: Tests of binding the *PRINT-LEVEL* variable
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10#|
11(deftest print-level.1
12  (with-standard-io-syntax
13   (let ((*print-readably* nil))
14     (loop for x in *mini-universe*
15           for s1 = (write-to-string x)
16           for s2 = (let ((*print-level* 0)) (write-to-string x))
17           when (and (or (consp x)
18                         (and (arrayp x)
19                              (not (stringp x))
20                              (not (typep x 'bit-vector)))
21                         (typep (class-of x) 'structure-class))
22                      (not (string= s2 "#")))
23           collect (list x s1 s2))))
24  nil)
25|#
26
27(defclass print-level-test-class nil (a b c))
28
29;;; The CLHS page for PRINT-OBJECT makes it clear that tests
30;;; PRINT-LEVEL.2,6,7,10,11 were testing for implementation-dependent
31;;; behavior. They have been commented out.
32
33#|
34(deftest print-level.2
35  (with-standard-io-syntax
36   (write-to-string (make-instance 'print-level-test-class)
37                    :level 0
38                    :readably nil))
39  "#")
40|#
41
42(deftest print-level.3
43  (with-standard-io-syntax
44   (write-to-string (make-array '(4) :initial-contents '(a b c d))
45                    :readably nil
46                    :array t
47                    :level 0))
48  "#")
49
50(deftest print-level.4
51  (with-standard-io-syntax
52   (write-to-string (make-array '(4) :initial-contents '(1 1 0 1)
53                                :element-type 'bit)
54                    :readably nil
55                    :array t
56                    :level 0))
57  "#*1101")
58
59(deftest print-level.5
60  (with-standard-io-syntax
61   (write-to-string "abcd"
62                    :readably nil
63                    :array t
64                    :level 0))
65  "\"abcd\"")
66
67(define-condition print-level-condition (condition) (a b c))
68
69#|
70(deftest print-level.6
71  (with-standard-io-syntax
72   (write-to-string (make-condition 'print-level-condition)
73                    :level 0 :pretty nil :readably nil))
74  "#")
75
76(deftest print-level.7
77  (with-standard-io-syntax
78   (write-to-string (make-condition 'print-level-condition)
79                    :level 0 :pretty t :readably nil))
80  "#")
81|#
82
83(defstruct print-level-struct)
84
85(deftest print-level.8
86  (with-standard-io-syntax
87   (let* ((*package* (find-package "CL-TEST"))
88          (*print-pretty* nil)
89          (s (make-print-level-struct)))
90     (values
91      (write-to-string s :level 0   :readably nil)
92      (write-to-string s :level 1   :readably nil)
93      (write-to-string s :level nil :readably nil))))
94  "#S(PRINT-LEVEL-STRUCT)"
95  "#S(PRINT-LEVEL-STRUCT)"
96  "#S(PRINT-LEVEL-STRUCT)")
97
98(deftest print-level.9
99  (with-standard-io-syntax
100   (let* ((*package* (find-package "CL-TEST"))
101          (*print-pretty* t)
102          (s (make-print-level-struct)))
103     (values
104      (write-to-string s :level 0   :readably nil)
105      (write-to-string s :level 1   :readably nil)
106      (write-to-string s :level nil :readably nil))))
107  "#S(PRINT-LEVEL-STRUCT)"
108  "#S(PRINT-LEVEL-STRUCT)"
109  "#S(PRINT-LEVEL-STRUCT)")
110
111(defstruct print-level-struct2 a b c)
112
113#|
114(deftest print-level.10
115  (with-standard-io-syntax
116   (let ((*package* (find-package "CL-TEST")))
117     (write-to-string (make-print-level-struct2)
118                      :level 0 :pretty nil :readably nil)))
119  "#")
120
121(deftest print-level.11
122  (with-standard-io-syntax
123   (let ((*package* (find-package "CL-TEST")))
124     (write-to-string (make-print-level-struct2)
125                      :level 0 :pretty t :readably nil)))
126  "#")
127|#
128
129(deftest print-level.12
130  (with-standard-io-syntax
131   (let ((*print-level* (1+ most-positive-fixnum)))
132     (write-to-string '((1 2) (3 4)) :pretty nil :readably nil)))
133  "((1 2) (3 4))")
Note: See TracBrowser for help on using the repository browser.