print-cons.lsp 4.79 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Apr 19 07:28:40 2004
;;;; Contains: Tests of printing of conses

pfdietz's avatar
pfdietz committed
6 7
(compile-and-load "printer-aux.lsp")

8 9 10
(in-package :cl-test)

(deftest print.cons.1
pfdietz's avatar
pfdietz committed
11 12 13
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(|A|) :case :upcase :pretty nil :escape nil)))
14 15 16
  "(A)")

(deftest print.cons.2
pfdietz's avatar
pfdietz committed
17 18 19
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(|A| |B|) :case :upcase :pretty nil :escape nil)))
20 21 22
  "(A B)")

(deftest print.cons.3
pfdietz's avatar
pfdietz committed
23 24 25
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (cons '|A| '|B|) :case :upcase :pretty nil :escape nil)))
26 27 28
  "(A . B)")

(deftest print.cons.4
pfdietz's avatar
pfdietz committed
29 30 31
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t)))
32 33 34
  "(#:X . #:X)")

(deftest print.cons.5
pfdietz's avatar
pfdietz committed
35 36 37
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t :circle t)))
38 39 40
  "(#1=#:X . #1#)")

(deftest print.cons.6
pfdietz's avatar
pfdietz committed
41 42 43
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s1 (make-symbol "X"))
sds's avatar
sds committed
44 45 46
                            (s2 (make-symbol "X")))
                        (list s1 s2 s1 s2))
                      :case :upcase :pretty nil :escape t :circle t)))
47 48
  "(#1=#:X #2=#:X #1# #2#)")

pfdietz's avatar
pfdietz committed
49
(deftest print.cons.7
pfdietz's avatar
pfdietz committed
50 51 52
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((a (list 17 nil)))
sds's avatar
sds committed
53 54 55
                        (setf (cdr a) a)
                        a)
                      :circle t :pretty nil :escape nil)))
pfdietz's avatar
pfdietz committed
56 57 58 59 60
  "#1=(17 . #1#)")

;;; Random printing

(deftest print.cons.random.1
pfdietz's avatar
pfdietz committed
61 62 63
  (trim-list
   (loop
    for x = (make-random-cons-tree (random 100))
64
    repeat 50
pfdietz's avatar
pfdietz committed
65 66
    nconc (randomly-check-readability x))
   10)
pfdietz's avatar
pfdietz committed
67 68
  nil)

69
;; random circular cons graphs
70
#-lispworks
71 72
(deftest print.cons.random.2
  (loop repeat 50
sds's avatar
sds committed
73 74 75 76 77 78 79 80 81 82 83
        nconc
        (let* ((n 20)
               (conses (apply #'vector
                              (loop repeat n collect (cons nil nil)))))
          (loop for x across conses
                for j = (random n)
                for k = (random n)
                do (setf (car x) (elt conses j)
                         (cdr x) (elt conses k)))
          (randomly-check-readability (elt conses 0) :test #'is-similar
                                      :circle t)))
84 85
  nil)

86 87 88
;;; Printing with *print-length*

(deftest print.cons.length.1
pfdietz's avatar
pfdietz committed
89 90 91
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a) :length 0 :pretty nil :escape nil)))
92 93 94
  "(...)")

(deftest print.cons.length.2
pfdietz's avatar
pfdietz committed
95 96 97
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(81) :length 1 :pretty nil :escape nil)))
98 99 100
  "(81)")

(deftest print.cons.length.3
pfdietz's avatar
pfdietz committed
101 102 103
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(4 . 8) :length 1 :pretty nil :escape nil)))
104 105 106
  "(4 . 8)")

(deftest print.cons.length.4
pfdietz's avatar
pfdietz committed
107
  (my-with-standard-io-syntax
sds's avatar
sds committed
108
   (let ((*print-readably* nil))
pfdietz's avatar
pfdietz committed
109
     (write-to-string '(4 8) :length 1 :pretty nil :escape nil)))
110 111 112
  "(4 ...)")

(deftest print.cons.length.5
pfdietz's avatar
pfdietz committed
113 114 115
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a b c d e f g h i j k l m n o p)
sds's avatar
sds committed
116 117
                      :case :downcase :length 10
                      :pretty nil :escape nil)))
118 119 120 121
  "(a b c d e f g h i j ...)")


(deftest print.cons.length.6
pfdietz's avatar
pfdietz committed
122
  (my-with-standard-io-syntax
sds's avatar
sds committed
123
   (let ((*print-readably* nil))
pfdietz's avatar
pfdietz committed
124
     (write-to-string '(((((((0)))))))
sds's avatar
sds committed
125 126
                      :case :downcase :length 3
                      :pretty nil :escape nil)))
127 128 129 130 131
  "(((((((0)))))))")

;;; Printing with *print-level*

(deftest print.cons.level.1
pfdietz's avatar
pfdietz committed
132 133 134
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
sds's avatar
sds committed
135 136
                      :case :downcase :level 0
                      :escape nil :pretty nil)))
137 138 139
  "#")

(deftest print.cons.level.2
pfdietz's avatar
pfdietz committed
140 141 142
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
sds's avatar
sds committed
143 144
                      :case :downcase :level 1
                      :escape nil :pretty nil)))
145 146 147
  "(a)")

(deftest print.cons.level.3
pfdietz's avatar
pfdietz committed
148 149 150
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '((a))
sds's avatar
sds committed
151 152
                      :case :downcase :level 1
                      :escape nil :pretty nil)))
153 154 155 156
  "(#)")


(deftest print.cons.level.4
pfdietz's avatar
pfdietz committed
157 158 159
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
sds's avatar
sds committed
160 161
                      :case :downcase :level 2
                      :escape nil :pretty nil)))
162 163 164
  "(a)")

(deftest print.cons.level.5
pfdietz's avatar
pfdietz committed
165 166 167
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(#(a) #*1101 "abc")
sds's avatar
sds committed
168 169
                      :case :downcase :level 1
                      :pretty nil)))
170
  "(# #*1101 \"abc\")")