0.8alpha.0.10:
[sbcl/simd.git] / tests / print.impure.lisp
blob68420b18ebe5d4c7af37cc624ba387588f34285c
1 ;;;; miscellaneous tests of printing stuff
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;;
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (load "assertoid.lisp")
15 (use-package "ASSERTOID")
17 ;;; We should be able to output X readably (at least when *READ-EVAL*).
18 (defun assert-readable-output (x)
19 (assert (eql x
20 (let ((*read-eval* t))
21 (read-from-string (with-output-to-string (s)
22 (write x :stream s :readably t)))))))
24 ;;; Even when *READ-EVAL* is NIL, we should be able to output some
25 ;;; (not necessarily readable) representation without signalling an
26 ;;; error.
27 (defun assert-unreadable-output (x)
28 (let ((*read-eval* nil))
29 (with-output-to-string (s) (write x :stream s :readably nil))))
31 (defun assert-output (x)
32 (assert-readable-output x)
33 (assert-unreadable-output x))
35 ;;; Nathan Froyd reported that sbcl-0.6.11.34 screwed up output of
36 ;;; floating point infinities.
37 (dolist (x (list short-float-positive-infinity short-float-negative-infinity
38 single-float-positive-infinity single-float-negative-infinity
39 double-float-positive-infinity double-float-negative-infinity
40 long-float-positive-infinity long-float-negative-infinity))
41 (assert-output x))
43 ;;; Eric Marsden reported that this would blow up in CMU CL (even
44 ;;; though ANSI says that the mismatch between ~F expected type and
45 ;;; provided string type is supposed to be handled without signalling
46 ;;; an error) and provided a fix which was ported to sbcl-0.6.12.35.
47 (assert (null (format t "~F" "foo")))
49 ;;; This was a bug in SBCL until 0.6.12.40 (originally reported as a
50 ;;; CMU CL bug by Erik Naggum on comp.lang.lisp).
51 (loop for *print-base* from 2 to 36
52 with *print-radix* = t
54 (assert (string= "#*101" (format nil "~S" #*101))))
56 ;;; bug in sbcl-0.7.1.25, reported by DB sbcl-devel 2002-02-25
57 (assert (string= "0.5" (format nil "~2D" 0.5)))
59 ;;; we want malformed format strings to cause errors rather than have
60 ;;; some DWIM "functionality".
61 (assert (raises-error? (format nil "~:2T")))
63 ;;; bug reported, with fix, by Robert Strandh, sbcl-devel 2002-03-09,
64 ;;; fixed in sbcl-0.7.1.36:
65 (assert (string= (format nil "~2,3,8,'0$" 1234567.3d0) "1234567.30"))
67 ;;; checks that other FORMAT-DOLLAR output remains sane after the
68 ;;; 0.7.1.36 change
69 (assert (string= (format nil "~$" 0) "0.00"))
70 (assert (string= (format nil "~$" 4) "4.00"))
71 (assert (string= (format nil "~$" -4.0) "-4.00"))
72 (assert (string= (format nil "~2,7,11$" -4.0) "-0000004.00"))
73 (assert (string= (format nil "~2,7,11,' $" 1.1) " 0000001.10"))
74 (assert (string= (format nil "~1,7,11,' $" 1.1) " 0000001.1"))
75 (assert (string= (format nil "~1,3,8,' $" 7.3) " 007.3"))
76 (assert (string= (format nil "~2,3,8,'0$" 7.3) "00007.30"))
78 ;;; Check for symbol lookup in ~/ / directive -- double-colon was
79 ;;; broken in 0.7.1.36 and earlier
80 (defun print-foo (stream arg colonp atsignp &rest params)
81 (declare (ignore colonp atsignp params))
82 (format stream "~d" arg))
84 (assert (string= (format nil "~/print-foo/" 2) "2"))
85 (assert (string= (format nil "~/cl-user:print-foo/" 2) "2"))
86 (assert (string= (format nil "~/cl-user::print-foo/" 2) "2"))
87 (assert (raises-error? (format nil "~/cl-user:::print-foo/" 2)))
88 (assert (raises-error? (format nil "~/cl-user:a:print-foo/" 2)))
89 (assert (raises-error? (format nil "~/a:cl-user:print-foo/" 2)))
90 (assert (raises-error? (format nil "~/cl-user:print-foo:print-foo/" 2)))
92 ;;; better make sure that we get this one right, too
93 (defun print-foo\:print-foo (stream arg colonp atsignp &rest params)
94 (declare (ignore colonp atsignp params))
95 (format stream "~d" arg))
97 (assert (string= (format nil "~/cl-user:print-foo:print-foo/" 2) "2"))
98 (assert (string= (format nil "~/cl-user::print-foo:print-foo/" 2) "2"))
100 ;;; Check for error detection of illegal directives in a~<..~> justify
101 ;;; block (see ANSI section 22.3.5.2)
102 (assert (raises-error? (format nil "~<~W~>" 'foo)))
103 (assert (raises-error? (format nil "~<~<~A~:>~>" '(foo))))
104 (assert (string= (format nil "~<~<~A~>~>" 'foo) "FOO"))
106 ;;; Check that arrays that we print while *PRINT-READABLY* is true are
107 ;;; in fact generating similar objects.
108 (assert (equal (array-dimensions
109 (read-from-string
110 (with-output-to-string (s)
111 (let ((*print-readably* t))
112 (print (make-array '(1 2 0)) s)))))
113 '(1 2 0)))
115 (assert (multiple-value-bind (result error)
116 (ignore-errors (read-from-string
117 (with-output-to-string (s)
118 (let ((*print-readably* t))
119 (print (make-array '(1 0 1)) s)))))
120 ;; it might not be readably-printable
121 (or (typep error 'print-not-readable)
122 ;; or else it had better have the same dimensions
123 (equal (array-dimensions result) '(1 0 1)))))
125 ;;; success
126 (quit :unix-status 104)