with-output-to-string.lsp 3.67 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Feb 14 20:33:51 2004
;;;; Contains: Tests of WITH-OUTPUT-TO-STRING

(in-package :cl-test)


(deftest with-output-to-string.1
  (with-output-to-string (s))
  "")

(deftest with-output-to-string.2
  (with-output-to-string (s) (write-char #\3 s))
  "3")

(deftest with-output-to-string.3
  (with-output-to-string (s (make-array 10 :fill-pointer 0
sds's avatar
sds committed
19
                                        :element-type 'character)))
20 21 22
  nil)

(deftest with-output-to-string.4
23
  :notes (:allow-nil-arrays :nil-vectors-are-strings)
24 25 26 27 28 29 30 31 32 33
  (let ((str (make-array 10 :fill-pointer 0 :element-type 'character)))
    (values
     (with-output-to-string
       (s str :element-type nil)
       (write-string "abcdef" s))
     str))
  "abcdef" "abcdef")

(deftest with-output-to-string.5
  (with-output-to-string (s (make-array 10 :fill-pointer 0
sds's avatar
sds committed
34 35
                                        :element-type 'character))
                         (values)))
36 37 38

(deftest with-output-to-string.6
  (with-output-to-string (s (make-array 10 :fill-pointer 0
sds's avatar
sds committed
39 40
                                        :element-type 'character))
                         (values 'a 'b 'c 'd))
41 42 43 44
  a b c d)

(deftest with-output-to-string.7
  (with-output-to-string (s nil :element-type 'character)
sds's avatar
sds committed
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)
sds's avatar
sds committed
50
                                    (write-char #\8 s))))
51 52
    (assert (typep str 'simple-base-string))
    str)
53 54 55
  "8")

(deftest with-output-to-string.9
56
  :notes (:allow-nil-arrays :nil-vectors-are-strings)
57 58 59 60 61
  (with-output-to-string (s nil :element-type nil))
  "")

(deftest with-output-to-string.10
  (let* ((s1 (make-array 20 :element-type 'character
sds's avatar
sds committed
62 63 64 65 66
                         :initial-element #\.))
         (s2 (make-array 10 :element-type 'character
                         :displaced-to s1
                         :displaced-index-offset 5
                         :fill-pointer 0)))
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83

    (values
     (with-output-to-string
       (s s2)
       (write-string "0123456789" s))
     s1
     s2))
  "0123456789"
  ".....0123456789....."
  "0123456789")

(deftest with-output-to-string.11
  (with-output-to-string (s) (declare (optimize safety)))
  "")

(deftest with-output-to-string.12
  (with-output-to-string (s) (declare (optimize safety))
sds's avatar
sds committed
84
                         (declare (optimize (speed 0))))
85 86 87 88 89 90 91 92 93 94
  "")

(deftest with-output-to-string.13
  (with-output-to-string
    (s)
    (write-char #\0 s)
    (write-char #\4 s)
    (write-char #\9 s))
  "049")

95 96
(deftest with-output-to-string.14
  (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0))
sds's avatar
sds committed
97 98 99 100 101 102 103
         (str2 (with-output-to-string
                 (s nil :element-type 'base-char)
                 (loop for i below 256
                       for c = (code-char i)
                       when (typep c 'base-char)
                       do (progn (write-char c s)
                                 (vector-push c str1))))))
104 105 106 107
    (if (string= str1 str2) :good
      (list str1 str2)))
  :good)

pfdietz's avatar
pfdietz committed
108 109 110 111 112 113 114
;;; Free declaration scope

(deftest with-output-to-string.15
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good))
sds's avatar
sds committed
115 116
        (with-output-to-string (s (return-from done x))
                               (declare (special x))))))
pfdietz's avatar
pfdietz committed
117 118 119 120 121 122 123
  :good)

(deftest with-output-to-string.16
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good)
sds's avatar
sds committed
124 125 126 127
            (str (make-array '(10) :element-type 'character
                             :fill-pointer 0)))
        (with-output-to-string (s str :element-type (return-from done x))
                               (declare (special x))))))
pfdietz's avatar
pfdietz committed
128
  :good)
129