tests/print.impure.lisp

   1 (in-package :cl-user)
   2
   3 (load "assertoid.lisp")
   4
   5 ;;; We should be able to output X readably (at least when *READ-EVAL*).
   6 (defun assert-readable-output (x)
   7   (assert (eql x
   8                (let ((*read-eval* t))
   9                  (read-from-string (with-output-to-string (s)
  10                                      (write x :stream s :readably t)))))))
  11
  12 ;;; Even when *READ-EVAL* is NIL, we should be able to output some
  13 ;;; (not necessarily readable) representation without signalling an
  14 ;;; error.
  15 (defun assert-unreadable-output (x)
  16   (let ((*read-eval* nil))
  17     (with-output-to-string (s) (write x :stream s :readably nil))))
  18
  19 (defun assert-output (x)
  20   (assert-readable-output x)
  21   (assert-unreadable-output x))
  22
  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))
  29   (assert-output x))
  30
  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")))
  36
  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
  41       do
  42       (assert (string= "#*101" (format nil "~S" #*101))))
  43
  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)))
  46
  47 ;;; we want malformed format strings to cause errors rather than have
  48 ;;; some DWIM "functionality".
  49 (assert (raises-error? (format nil "~:2T")))
  50
  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"))
  54
  55 ;;; checks that other FORMAT-DOLLAR output remains sane after the
  56 ;;; 0.7.1.36 change
  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"))
  65
  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))
  71
  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)))
  79
  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))
  84
  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"))
  87
  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"))
  93
  94 ;;; success
  95 (quit :unix-status 104)