print-strings.lsp 4.38 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Apr 19 05:53:48 2004
;;;; Contains: Tests of string printing

(in-package :cl-test)

8

9 10 11 12 13 14 15

(deftest print.string.1
  (with-standard-io-syntax
   (write-to-string "" :escape nil :readably nil))
  "")

(deftest print.string.2
pfdietz's avatar
pfdietz committed
16 17
  (with-standard-io-syntax
   (loop for c across +standard-chars+
sds's avatar
sds committed
18 19 20 21
         for s1 = (string c)
         for s2 = (write-to-string s1 :escape nil :readably nil)
         unless (string= s1 s2)
         collect (list c s1 s2)))
22 23 24
  nil)

(deftest print.string.3
pfdietz's avatar
pfdietz committed
25 26
  (with-standard-io-syntax
   (loop for i below 256
sds's avatar
sds committed
27 28 29 30 31 32 33
         for c = (code-char i)
         when c
         nconc
         (let* ((s1 (string c))
                (s2 (write-to-string s1 :escape nil :readably nil)))
           (unless (string= s1 s2)
             (list (list c s1 s2))))))
34 35 36
  nil)

(deftest print.string.4
pfdietz's avatar
pfdietz committed
37 38
  (with-standard-io-syntax
   (loop for c across +standard-chars+
sds's avatar
sds committed
39 40 41 42
         for s1 = (string c)
         for s2 = (write-to-string s1 :escape t :readably nil)
         unless (or (find c "\"\\") (string= (concatenate 'string "\"" s1 "\"") s2))
         collect (list c s1 s2)))
43 44 45
  nil)

(deftest print.string.5
pfdietz's avatar
pfdietz committed
46 47
  (with-standard-io-syntax
   (write-to-string "\"" :escape t :readably nil))
48 49 50
  "\"\\\"\"")

(deftest print.string.6
pfdietz's avatar
pfdietz committed
51 52
  (with-standard-io-syntax
   (write-to-string "\\" :escape t :readably nil))
53 54
  "\"\\\\\"")

pfdietz's avatar
pfdietz committed
55 56 57 58 59
;;; Not affected by *print-array*

(deftest print.string.7
  (with-standard-io-syntax
   (loop for s1 in (remove-if-not #'stringp *universe*)
sds's avatar
sds committed
60 61 62 63
         for s2 = (write-to-string s1 :escape nil :readably nil)
         for s3 = (write-to-string s1 :array t :escape nil :readably nil)
         unless (string= s2 s3)
         collect (list s1 s2 s3)))
pfdietz's avatar
pfdietz committed
64 65 66 67 68
  nil)

(deftest print.string.8
  (with-standard-io-syntax
   (loop for s1 in (remove-if-not #'stringp *universe*)
sds's avatar
sds committed
69 70 71 72
         for s2 = (write-to-string s1 :escape t :readably nil)
         for s3 = (write-to-string s1 :array t :escape t :readably nil)
         unless (string= s2 s3)
         collect (list s1 s2 s3)))
pfdietz's avatar
pfdietz committed
73 74 75 76 77
  nil)

;;; Only active elements of the string are printed

(deftest print.string.9
pfdietz's avatar
pfdietz committed
78
  (let* ((s (make-array '(10) :fill-pointer 5 :element-type 'character
sds's avatar
sds committed
79 80 81 82
                       :initial-contents "abcdefghij"))
         (result
          (with-standard-io-syntax
           (write-to-string s :escape nil :readably nil))))
pfdietz's avatar
pfdietz committed
83
    (or (and (string= result "abcde") t)
sds's avatar
sds committed
84
        result))
pfdietz's avatar
pfdietz committed
85
  t)
pfdietz's avatar
pfdietz committed
86 87

(deftest print.string.10
pfdietz's avatar
pfdietz committed
88
  (let* ((s (make-array '(10) :fill-pointer 5 :element-type 'character
sds's avatar
sds committed
89 90 91 92
                       :initial-contents "aBcDefGHij"))
         (result
          (with-standard-io-syntax
           (write-to-string s :escape t :readably nil))))
pfdietz's avatar
pfdietz committed
93
    (or (and (string= result "\"aBcDe\"") t)
sds's avatar
sds committed
94
        result))
pfdietz's avatar
pfdietz committed
95 96
  t)

pfdietz's avatar
pfdietz committed
97 98
(deftest print.string.11
  (let* ((s (make-array '(8) :element-type 'base-char
sds's avatar
sds committed
99 100 101 102 103
                        :initial-contents "abcdefgh"
                        :adjustable t))
         (result
          (with-standard-io-syntax
           (write-to-string s :escape t :readably nil))))
pfdietz's avatar
pfdietz committed
104
    (or (and (string= result "\"abcdefgh\"") t)
sds's avatar
sds committed
105
        result))
pfdietz's avatar
pfdietz committed
106 107 108 109
  t)

(deftest print.string.12
  (let* ((s1 (make-array '(8) :element-type 'character
sds's avatar
sds committed
110 111 112 113 114 115 116
                         :initial-contents "abcdefgh"))
         (s2 (make-array '(4) :element-type 'character
                         :displaced-to s1
                         :displaced-index-offset 2))
         (result
          (with-standard-io-syntax
           (write-to-string s2 :escape t :readably nil))))
pfdietz's avatar
pfdietz committed
117
    (or (and (string= result "\"cdef\"") t)
sds's avatar
sds committed
118
        result))
pfdietz's avatar
pfdietz committed
119 120 121 122 123 124 125 126
  t)

;;; *print-array* should not affect string printing

(deftest print.string.13
  (with-standard-io-syntax
   (write-to-string "1234" :array nil :readably nil :escape t))
  "\"1234\"")
sds's avatar
sds committed
127

pfdietz's avatar
pfdietz committed
128

pfdietz's avatar
pfdietz committed
129 130 131 132 133 134 135 136 137 138 139 140 141 142
;;; The ever-popular nil string

(deftest print.string.nil.1
  :notes (:nil-vectors-are-strings)
  (let ((s (make-array '(0) :element-type nil)))
    (write-to-string s :escape nil :readably nil))
  "")

(deftest print.string.nil.2
  :notes (:nil-vectors-are-strings)
  (let ((s (make-array '(0) :element-type nil)))
    (write-to-string s :escape t :readably nil))
  "\"\"")

pfdietz's avatar
pfdietz committed
143 144 145 146

;;; Random tests

(deftest print.string.random.1
pfdietz's avatar
pfdietz committed
147 148
  (trim-list
   (loop for len = (1+ (random 5))
sds's avatar
sds committed
149 150 151 152 153
         for s = (coerce (loop repeat len
                               collect (random-from-seq +standard-chars+))
                         'string)
         repeat 1000
         append (randomly-check-readability s))
pfdietz's avatar
pfdietz committed
154
   10)
pfdietz's avatar
pfdietz committed
155
  nil)