source: trunk/source/tests/ansi-tests/print-length.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Jul 27 08:27:37 2004
4;;;; Contains: Tests involving *PRINT-LENGTH*
5
6(in-package :cl-test)
7
8(compile-and-load "printer-aux.lsp")
9
10(def-print-test print-length.1
11  '(1)
12  "(...)"
13  (*print-length* 0))
14
15(def-print-test print-length.2
16  '(1)
17  "(1)"
18  (*print-length* nil))
19
20(def-print-test print-length.3
21  '(1)
22  "(1)"
23  (*print-length* 1))
24
25(def-print-test print-length.4
26  '(1 . 2)
27  "(1 . 2)"
28  (*print-length* 1))
29
30(deftest print-length.5
31  (let ((x '(|A| |B| |C| |D| |E| |F|)))
32    (with-standard-io-syntax
33     (let ((*print-case* :upcase)
34           (*print-escape* nil)
35           (*print-readably* nil)
36           (*print-pretty* nil)
37           (*print-length* nil))
38       (apply
39        #'values
40        (loop for i from 0 to 8
41              collect (let ((*print-length* i))
42                        (write-to-string x)))))))
43  "(...)"
44  "(A ...)"
45  "(A B ...)"
46  "(A B C ...)"
47  "(A B C D ...)"
48  "(A B C D E ...)"
49  "(A B C D E F)"
50  "(A B C D E F)"
51  "(A B C D E F)")
52
53(deftest print-length.6
54  (let ((x '(|A| |B| |C| |D| |E| |F| . |G|)))
55    (with-standard-io-syntax
56     (let ((*print-case* :upcase)
57           (*print-escape* nil)
58           (*print-readably* nil)
59           (*print-pretty* nil)
60           (*print-length* nil))
61       (apply
62        #'values
63        (loop for i from 0 to 8
64              collect (let ((*print-length* i))
65                        (write-to-string x)))))))
66  "(...)"
67  "(A ...)"
68  "(A B ...)"
69  "(A B C ...)"
70  "(A B C D ...)"
71  "(A B C D E ...)"
72  "(A B C D E F . G)"
73  "(A B C D E F . G)"
74  "(A B C D E F . G)")
75
76(def-print-test print-length.7
77  '(1)
78  "(1)"
79  (*print-length* (1+ most-positive-fixnum)))
80
81(deftest print-length.8
82  (let ((x #(|A| |B| |C| |D| |E| |F|)))
83    (with-standard-io-syntax
84     (let ((*print-case* :upcase)
85           (*print-escape* nil)
86           (*print-readably* nil)
87           (*print-pretty* nil)
88           (*print-length* nil))
89       (apply
90        #'values
91        (loop for i from 0 to 8
92              collect (let ((*print-length* i))
93                        (write-to-string x)))))))
94  "#(...)"
95  "#(A ...)"
96  "#(A B ...)"
97  "#(A B C ...)"
98  "#(A B C D ...)"
99  "#(A B C D E ...)"
100  "#(A B C D E F)"
101  "#(A B C D E F)"
102  "#(A B C D E F)")
103
104(def-print-test print-length.9
105  "A modest sentence with six words."
106  "\"A modest sentence with six words.\""
107  (*print-length* 0))
108
109(def-print-test print-length.10
110  #*00110101100011
111  "#*00110101100011"
112  (*print-length* 0))
113
114(defstruct print-length-struct foo)
115
116;;; The next test tacitly assumes issue STRUCTURE-READ-PRINT-SYNTAX
117
118(deftest print-length.11
119  (let ((result
120         (with-standard-io-syntax
121          (let ((*print-case* :upcase)
122                (*print-escape* nil)
123                (*print-readably* nil)
124                (*print-pretty* nil)
125                (*print-length* nil)
126                (*package* (find-package "CL-TEST"))
127                (s (make-print-length-struct :foo 17)))
128            (apply
129             #'list
130             (loop for i from 0 to 4
131                   collect (let ((*print-length* i))
132                             (write-to-string s))))))))
133    (if (member result
134                '(("#S(...)"
135                   "#S(PRINT-LENGTH-STRUCT ...)"
136                   "#S(PRINT-LENGTH-STRUCT :FOO ...)"
137                   "#S(PRINT-LENGTH-STRUCT :FOO 17)"
138                   "#S(PRINT-LENGTH-STRUCT :FOO 17)")
139                  ("#S(PRINT-LENGTH-STRUCT ...)"
140                   "#S(PRINT-LENGTH-STRUCT :FOO 17)"
141                   "#S(PRINT-LENGTH-STRUCT :FOO 17)"
142                   "#S(PRINT-LENGTH-STRUCT :FOO 17)"
143                   "#S(PRINT-LENGTH-STRUCT :FOO 17)"))
144                :test 'equal)
145        :good
146      result))
147  :good)
Note: See TracBrowser for help on using the repository browser.