← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/print-strings.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/print-strings.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Mon Apr 19 05:53:48 2004
 
4
;;;; Contains: Tests of string printing
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "printer-aux.lsp")
 
9
 
 
10
(deftest print.string.1
 
11
  (with-standard-io-syntax
 
12
   (write-to-string "" :escape nil :readably nil))
 
13
  "")
 
14
 
 
15
(deftest print.string.2
 
16
  (with-standard-io-syntax
 
17
   (loop for c across +standard-chars+
 
18
         for s1 = (string c)
 
19
         for s2 = (write-to-string s1 :escape nil :readably nil)
 
20
         unless (string= s1 s2)
 
21
         collect (list c s1 s2)))
 
22
  nil)
 
23
 
 
24
(deftest print.string.3
 
25
  (with-standard-io-syntax
 
26
   (loop for i below 256
 
27
         for c = (code-char i)
 
28
         when c
 
29
         nconc
 
30
         (let* ((s1 (string c))
 
31
                (s2 (write-to-string s1 :escape nil :readably nil)))
 
32
           (unless (string= s1 s2)
 
33
             (list (list c s1 s2))))))
 
34
  nil)
 
35
 
 
36
(deftest print.string.4
 
37
  (with-standard-io-syntax
 
38
   (loop for c across +standard-chars+
 
39
         for s1 = (string c)
 
40
         for s2 = (write-to-string s1 :escape t :readably nil)
 
41
         unless (or (find c "\"\\") (string= (concatenate 'string "\"" s1 "\"") s2))
 
42
         collect (list c s1 s2)))
 
43
  nil)
 
44
 
 
45
(deftest print.string.5
 
46
  (with-standard-io-syntax
 
47
   (write-to-string "\"" :escape t :readably nil))
 
48
  "\"\\\"\"")
 
49
 
 
50
(deftest print.string.6
 
51
  (with-standard-io-syntax
 
52
   (write-to-string "\\" :escape t :readably nil))
 
53
  "\"\\\\\"")
 
54
 
 
55
;;; Not affected by *print-array*
 
56
 
 
57
(deftest print.string.7
 
58
  (with-standard-io-syntax
 
59
   (loop for s1 in (remove-if-not #'stringp *universe*)
 
60
         for s2 = (write-to-string s1 :escape nil :readably nil)
 
61
         for s3 = (write-to-string s1 :array t :escape nil :readably nil)
 
62
         unless (string= s2 s3)
 
63
         collect (list s1 s2 s3)))
 
64
  nil)
 
65
 
 
66
(deftest print.string.8
 
67
  (with-standard-io-syntax
 
68
   (loop for s1 in (remove-if-not #'stringp *universe*)
 
69
         for s2 = (write-to-string s1 :escape t :readably nil)
 
70
         for s3 = (write-to-string s1 :array t :escape t :readably nil)
 
71
         unless (string= s2 s3)
 
72
         collect (list s1 s2 s3)))
 
73
  nil)
 
74
 
 
75
;;; Only active elements of the string are printed
 
76
 
 
77
(deftest print.string.9
 
78
  (let* ((s (make-array '(10) :fill-pointer 5 :element-type 'character
 
79
                       :initial-contents "abcdefghij"))
 
80
         (result
 
81
          (with-standard-io-syntax
 
82
           (write-to-string s :escape nil :readably nil))))
 
83
    (or (and (string= result "abcde") t)
 
84
        result))
 
85
  t)
 
86
 
 
87
(deftest print.string.10
 
88
  (let* ((s (make-array '(10) :fill-pointer 5 :element-type 'character
 
89
                       :initial-contents "aBcDefGHij"))
 
90
         (result
 
91
          (with-standard-io-syntax
 
92
           (write-to-string s :escape t :readably nil))))
 
93
    (or (and (string= result "\"aBcDe\"") t)
 
94
        result))
 
95
  t)
 
96
 
 
97
(deftest print.string.11
 
98
  (let* ((s (make-array '(8) :element-type 'base-char
 
99
                        :initial-contents "abcdefgh"
 
100
                        :adjustable t))
 
101
         (result
 
102
          (with-standard-io-syntax
 
103
           (write-to-string s :escape t :readably nil))))
 
104
    (or (and (string= result "\"abcdefgh\"") t)
 
105
        result))
 
106
  t)
 
107
 
 
108
(deftest print.string.12
 
109
  (let* ((s1 (make-array '(8) :element-type 'character
 
110
                         :initial-contents "abcdefgh"))
 
111
         (s2 (make-array '(4) :element-type 'character
 
112
                         :displaced-to s1
 
113
                         :displaced-index-offset 2))
 
114
         (result
 
115
          (with-standard-io-syntax
 
116
           (write-to-string s2 :escape t :readably nil))))
 
117
    (or (and (string= result "\"cdef\"") t)
 
118
        result))
 
119
  t)
 
120
 
 
121
;;; *print-array* should not affect string printing
 
122
 
 
123
(deftest print.string.13
 
124
  (with-standard-io-syntax
 
125
   (write-to-string "1234" :array nil :readably nil :escape t))
 
126
  "\"1234\"")
 
127
    
 
128
 
 
129
;;; The ever-popular nil string
 
130
 
 
131
(deftest print.string.nil.1
 
132
  :notes (:nil-vectors-are-strings)
 
133
  (let ((s (make-array '(0) :element-type nil)))
 
134
    (write-to-string s :escape nil :readably nil))
 
135
  "")
 
136
 
 
137
(deftest print.string.nil.2
 
138
  :notes (:nil-vectors-are-strings)
 
139
  (let ((s (make-array '(0) :element-type nil)))
 
140
    (write-to-string s :escape t :readably nil))
 
141
  "\"\"")
 
142
 
 
143
 
 
144
;;; Random tests
 
145
 
 
146
(deftest print.string.random.1
 
147
  (trim-list
 
148
   (loop for len = (1+ (random 5))
 
149
         for s = (coerce (loop repeat len
 
150
                               collect (random-from-seq +standard-chars+))
 
151
                         'string)
 
152
         repeat 1000
 
153
         append (randomly-check-readability s))
 
154
   10)
 
155
  nil)