source: trunk/source/tests/ansi-tests/with-output-to-string.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.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Feb 14 20:33:51 2004
4;;;; Contains: Tests of WITH-OUTPUT-TO-STRING
5
6(in-package :cl-test)
7
8
9(deftest with-output-to-string.1
10  (with-output-to-string (s))
11  "")
12
13(deftest with-output-to-string.2
14  (with-output-to-string (s) (write-char #\3 s))
15  "3")
16
17(deftest with-output-to-string.3
18  (with-output-to-string (s (make-array 10 :fill-pointer 0
19                                        :element-type 'character)))
20  nil)
21
22(deftest with-output-to-string.4
23  :notes (:allow-nil-arrays :nil-vectors-are-strings)
24  (let ((str (make-array 10 :fill-pointer 0 :element-type 'character)))
25    (values
26     (with-output-to-string
27       (s str :element-type nil)
28       (write-string "abcdef" s))
29     str))
30  "abcdef" "abcdef")
31
32(deftest with-output-to-string.5
33  (with-output-to-string (s (make-array 10 :fill-pointer 0
34                                        :element-type 'character))
35                         (values)))
36
37(deftest with-output-to-string.6
38  (with-output-to-string (s (make-array 10 :fill-pointer 0
39                                        :element-type 'character))
40                         (values 'a 'b 'c 'd))
41  a b c d)
42
43(deftest with-output-to-string.7
44  (with-output-to-string (s nil :element-type 'character)
45                         (write-char #\& s))
46  "&")
47
48(deftest with-output-to-string.8
49  (let ((str (with-output-to-string (s nil :element-type 'base-char)
50                                    (write-char #\8 s))))
51    (assert (typep str 'simple-base-string))
52    str)
53  "8")
54
55(deftest with-output-to-string.9
56  :notes (:allow-nil-arrays :nil-vectors-are-strings)
57  (with-output-to-string (s nil :element-type nil))
58  "")
59
60(deftest with-output-to-string.10
61  (let* ((s1 (make-array 20 :element-type 'character
62                         :initial-element #\.))
63         (s2 (make-array 10 :element-type 'character
64                         :displaced-to s1
65                         :displaced-index-offset 5
66                         :fill-pointer 0)))
67
68    (values
69     (with-output-to-string
70       (s s2)
71       (write-string "0123456789" s))
72     s1
73     s2))
74  "0123456789"
75  ".....0123456789....."
76  "0123456789")
77
78(deftest with-output-to-string.11
79  (with-output-to-string (s) (declare (optimize safety)))
80  "")
81
82(deftest with-output-to-string.12
83  (with-output-to-string (s) (declare (optimize safety))
84                         (declare (optimize (speed 0))))
85  "")
86
87(deftest with-output-to-string.13
88  (with-output-to-string
89    (s)
90    (write-char #\0 s)
91    (write-char #\4 s)
92    (write-char #\9 s))
93  "049")
94
95(deftest with-output-to-string.14
96  (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0))
97         (str2 (with-output-to-string
98                 (s nil :element-type 'base-char)
99                 (loop for i below 256
100                       for c = (code-char i)
101                       when (typep c 'base-char)
102                       do (progn (write-char c s)
103                                 (vector-push c str1))))))
104    (if (string= str1 str2) :good
105      (list str1 str2)))
106  :good)
107
108;;; Free declaration scope
109
110(deftest with-output-to-string.15
111  (block done
112    (let ((x :bad))
113      (declare (special x))
114      (let ((x :good))
115        (with-output-to-string (s (return-from done x))
116                               (declare (special x))))))
117  :good)
118
119(deftest with-output-to-string.16
120  (block done
121    (let ((x :bad))
122      (declare (special x))
123      (let ((x :good)
124            (str (make-array '(10) :element-type 'character
125                             :fill-pointer 0)))
126        (with-output-to-string (s str :element-type (return-from done x))
127                               (declare (special x))))))
128  :good)
129
Note: See TracBrowser for help on using the repository browser.