(defvar check-count 0)
(defvar check-errors 0)
(defun check (message x y)
  (set 'check-count (+ check-count 1))
  (if (boundp '*check-print-ok*) t (set '*check-print-ok* nil))
  (if (equal x y)
      (if (symbol-value '*check-print-ok*)
	  (format t "OK: ~a <~a>~%" message x))
    (progn
      (format t "ERROR: ~a <~s;~s>~%" message x y)
      (set 'check-errors (+ check-errors 1)))))

(check "dpb4" (dpb 10 (byte 4 50) -1) -5629499534213121)

;;; formatting:

(check "lformatd1" (format nil "[~3d]" 5 6) "[  5]")
(check "lformat{}1" (format nil "%~3@{abc~}%") "%%")
(check "lformat{}2" (format nil "%~3@{abc~:}%") "%abc%")
(check "lformat{}3" (format nil "%~@{abc~:}%") "%abc%")
(check "lformat{}W"
       (format nil "The winners are:~{ ~a~} -> ~d."
	       '("fred" "harry" "jill") 3)
       "The winners are: fred harry jill -> 3.")
(check "lformat{}P" (format nil "Pairs:~{ <~a,~S>~}." '(A 1 B 2 C 3))
       "Pairs: <A,1> <B,2> <C,3>.")
(check "lformat@{}P" (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3)
       "Pairs: <A,1> <B,2> <C,3>.")
(check "lformat:{}P" 
       (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3)))
       "Pairs: <A,1> <B,2> <C,3>.")
(check "lformat:@{}P"
       (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3))
       "Pairs: <A,1> <B,2> <C,3>.")
(check "lformat{}PS"
       (format nil "Pairs:~{ <~S.~S>~}." '("a" 1 "b" 2 "c" 3))
       "Pairs: <\"a\".1> <\"b\".2> <\"c\".3>.")
(set 'hot-dog '((hot dog) (hamburger) (ice cream) (french fries)))
(check "lformat:^" (format nil "~:{/~S~:^ ...~}" hot-dog)
       "/HOT .../HAMBURGER .../ICE .../FRENCH")
(check "lformat^" (format nil "~:{/~S~^ ...~}" hot-dog)
       "/HOT .../HAMBURGER/ICE .../FRENCH ...")
(check "lformat:#^" (format nil "~:{/~S~#:^ ...~}" hot-dog)
       "/HOT .../HAMBURGER")

(format t "Encountered ~d errors in ~d tests.~%" check-errors check-count)
