with-output-to-string.lsp 3.67 KB
Newer Older
pfdietz's avatar
pfdietz committed
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)))
pfdietz's avatar
pfdietz committed
20 21 22
  nil)

(deftest with-output-to-string.4
23
  :notes (:allow-nil-arrays :nil-vectors-are-strings)
pfdietz's avatar
pfdietz committed
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)))
pfdietz's avatar
pfdietz committed
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))
pfdietz's avatar
pfdietz committed
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))
pfdietz's avatar
pfdietz committed
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)
pfdietz's avatar
pfdietz committed
53 54 55
  "8")

(deftest with-output-to-string.9
56
  :notes (:allow-nil-arrays :nil-vectors-are-strings)
pfdietz's avatar
pfdietz committed
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)))
pfdietz's avatar
pfdietz committed
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))))
pfdietz's avatar
pfdietz committed
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