3 (load "assertoid.lisp")
5 ;;; We should be able to output X readably (at least when *READ-EVAL*).
6 (defun assert-readable-output (x)
9 (read-from-string (with-output-to-string (s)
10 (write x
:stream s
:readably t
)))))))
12 ;;; Even when *READ-EVAL* is NIL, we should be able to output some
13 ;;; (not necessarily readable) representation without signalling an
15 (defun assert-unreadable-output (x)
16 (let ((*read-eval
* nil
))
17 (with-output-to-string (s) (write x
:stream s
:readably nil
))))
19 (defun assert-output (x)
20 (assert-readable-output x
)
21 (assert-unreadable-output x
))
23 ;;; Nathan Froyd reported that sbcl-0.6.11.34 screwed up output of
24 ;;; floating point infinities.
25 (dolist (x (list short-float-positive-infinity short-float-negative-infinity
26 single-float-positive-infinity single-float-negative-infinity
27 double-float-positive-infinity double-float-negative-infinity
28 long-float-positive-infinity long-float-negative-infinity
))
31 ;;; Eric Marsden reported that this would blow up in CMU CL (even
32 ;;; though ANSI says that the mismatch between ~F expected type and
33 ;;; provided string type is supposed to be handled without signalling
34 ;;; an error) and provided a fix which was ported to sbcl-0.6.12.35.
35 (assert (null (format t
"~F" "foo")))
37 ;;; This was a bug in SBCL until 0.6.12.40 (originally reported as a
38 ;;; CMU CL bug by Erik Naggum on comp.lang.lisp).
39 (loop for
*print-base
* from
2 to
36
40 with
*print-radix
* = t
42 (assert (string= "#*101" (format nil
"~S" #*101))))
44 ;;; bug in sbcl-0.7.1.25, reported by DB sbcl-devel 2002-02-25
45 (assert (string= "0.5" (format nil
"~2D" 0.5)))
47 ;;; we want malformed format strings to cause errors rather than have
48 ;;; some DWIM "functionality".
49 (assert (raises-error?
(format nil
"~:2T")))
51 ;;; bug reported, with fix, by Robert Strandh, sbcl-devel 2002-03-09,
52 ;;; fixed in sbcl-0.7.1.36:
53 (assert (string= (format nil
"~2,3,8,'0$" 1234567.3d0
) "1234567.30"))
55 ;;; checks that other FORMAT-DOLLAR output remains sane after the
57 (assert (string= (format nil
"~$" 0) "0.00"))
58 (assert (string= (format nil
"~$" 4) "4.00"))
59 (assert (string= (format nil
"~$" -
4.0) "-4.00"))
60 (assert (string= (format nil
"~2,7,11$" -
4.0) "-0000004.00"))
61 (assert (string= (format nil
"~2,7,11,' $" 1.1) " 0000001.10"))
62 (assert (string= (format nil
"~1,7,11,' $" 1.1) " 0000001.1"))
63 (assert (string= (format nil
"~1,3,8,' $" 7.3) " 007.3"))
64 (assert (string= (format nil
"~2,3,8,'0$" 7.3) "00007.30"))
66 ;;; Check for symbol lookup in ~/ / directive -- double-colon was
67 ;;; broken in 0.7.1.36 and earlier
68 (defun print-foo (stream arg colonp atsignp
&rest params
)
69 (declare (ignore colonp atsignp params
))
70 (format stream
"~d" arg
))
72 (assert (string= (format nil
"~/print-foo/" 2) "2"))
73 (assert (string= (format nil
"~/cl-user:print-foo/" 2) "2"))
74 (assert (string= (format nil
"~/cl-user::print-foo/" 2) "2"))
75 (assert (raises-error?
(format nil
"~/cl-user:::print-foo/" 2)))
76 (assert (raises-error?
(format nil
"~/cl-user:a:print-foo/" 2)))
77 (assert (raises-error?
(format nil
"~/a:cl-user:print-foo/" 2)))
78 (assert (raises-error?
(format nil
"~/cl-user:print-foo:print-foo/" 2)))
80 ;;; better make sure that we get this one right, too
81 (defun print-foo\
:print-foo
(stream arg colonp atsignp
&rest params
)
82 (declare (ignore colonp atsignp params
))
83 (format stream
"~d" arg
))
85 (assert (string= (format nil
"~/cl-user:print-foo:print-foo/" 2) "2"))
86 (assert (string= (format nil
"~/cl-user::print-foo:print-foo/" 2) "2"))
88 ;;; Check for error detection of illegal directives in a~<..~> justify
89 ;;; block (see ANSI section 22.3.5.2)
90 (assert (raises-error?
(format nil
"~<~W~>" 'foo
)))
91 (assert (raises-error?
(format nil
"~<~<~A~:>~>" '(foo))))
92 (assert (string= (format nil
"~<~<~A~>~>" 'foo
) "FOO"))
95 (quit :unix-status
104)