;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jul  4 07:17:52 2004
;;;; Contains: Tests of PPRINT-LOGICAL-BLOCK

(in-package :cl-test)

(deftest pprint-logical-block.1
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil))
     (with-open-stream
      (os (make-string-output-stream))
      (values
       (multiple-value-list (pprint-logical-block (os 1)))
       (get-output-stream-string os)))))
  (nil) "1")

(deftest pprint-logical-block.2
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(1 a (b) (c . d) 1.0s0 2.0f0 -3.0d0 4.0l0 1/2 #(x y z))))
     (string=t (with-output-to-string (s) (write val :stream s))
               (with-output-to-string (s) (pprint-logical-block (s val) (write val :stream s))))))
  t)

(deftest pprint-logical-block.3
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
         (*print-right-margin* 100)
         (*print-readably* nil))
     (with-output-to-string
       (*standard-output*)
       (pprint-logical-block (nil 1)))))
  "1")

(deftest pprint-logical-block.4
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
         (*print-right-margin* 100)
         (*print-readably* nil))
     (with-output-to-string
       (os)
       (with-input-from-string
        (is "")
        (with-open-stream (*terminal-io* (make-two-way-stream is os))
                          (pprint-logical-block (t 1)))))))
  "1")

(deftest pprint-logical-block.5
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(1)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val)
        (write (car val) :stream os)))))
  "1")

(deftest pprint-logical-block.6
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(2)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :prefix "[" :suffix "]")
        (write (car val) :stream os)))))
  "[2]")

(deftest pprint-logical-block.7
  :notes (:nil-vectors-are-strings)
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(3)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val
            :prefix (make-array '(0) :element-type nil)
            :suffix (make-array '(0) :element-type nil))
        (write (car val) :stream os)))))
  "3")

(deftest pprint-logical-block.8
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(4)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val
            :prefix (make-array '(10) :element-type 'character
                                :initial-contents "abcdefghij"
                                :fill-pointer 3)
            :suffix (make-array '(2) :element-type 'base-char
                                :initial-contents "!?"
                                :adjustable t))
        (write (car val) :stream os)))))
  "abc4!?")

(deftest pprint-logical-block.9
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-level* 1)
         (val '((4))))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :prefix "{" :suffix "}")
        (pprint-logical-block
         (os (car val)  :prefix "[" :suffix "]")
         (write (caar val) :stream os))))))
  "{#}")

(deftest pprint-logical-block.10
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-level* 0)
         (val '(5)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :prefix "[" :suffix "]")
        (write (car val) :stream os)))))
  "#")

(deftest pprint-logical-block.11
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(6)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :per-line-prefix "abcd")
        (write (car val) :stream os)))))
  "abcd6")

(deftest pprint-logical-block.12
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(a b c)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :per-line-prefix "abcd")
        (write 1 :stream os)
        (terpri os)
        (terpri os)
        (write 2 :stream os)
        (terpri os)
        (write 3 :stream os)))))

  "abcd1
abcd
abcd2
abcd3")

;;; Same as pprint-logical-block.10, but *print-pretty* is bound to nil
(deftest pprint-logical-block.13
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-level* 0)
         (val '(5)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :prefix "[" :suffix "]")
        (write (car val) :stream os)))))
  "#")

;;; Both :suffix and :per-line-prefix may be supplied
(deftest pprint-logical-block.14
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val '(6)))
     (with-output-to-string
       (os)
       (pprint-logical-block (os val :per-line-prefix "[" :suffix "]")
                             (write (car val) :stream os)))))
  "[6]")

;;; Declarations are allowed

(deftest pprint-logical-block.15
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (x 0))
     (with-output-to-string
       (os)
       (declare (integer x))
       (declare (optimize (safety 3))))))
  "")

;;; Two conditions that cause :prefix, :suffix to be omitted

(deftest pprint-logical-block.16
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (val 9))
     (with-output-to-string
       (os)
       (pprint-logical-block (os val :prefix "[" :suffix "]")
                             (write val :stream os)))))
  "9")

(deftest pprint-logical-block.17
  (with-standard-io-syntax
   (let* ((*print-pretty* t)
          (*print-right-margin* 100)
          (*print-readably* nil)
          (*print-circle* t)
          (v1 '(8))
          (val (list v1 v1)))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os val :prefix "(" :suffix ")")
        (pprint-logical-block (os (car val) :prefix "(" :suffix ")")
                              (write (caar val) :stream os))
        (write-char #\Space os)
        (pprint-logical-block (os (cadr val) :prefix "(" :suffix ")")
                              (write (caadr val) :stream os))))))
  "(#1=(8) #1#)")

;;; Error cases

(deftest pprint-logical-block.error.1
  (check-type-error #'(lambda (x)
                        (pprint-logical-block (*standard-output* '(1) :prefix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.1-unsafe
  (check-type-error #'(lambda (x)
                        (declare (optimize (safety 0)))
                        (pprint-logical-block (*standard-output* '(1) :prefix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.2
  (check-type-error #'(lambda (x)
                        (pprint-logical-block (*standard-output* '(1) :suffix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.2-unsafe
  (check-type-error #'(lambda (x)
                        (declare (optimize (safety 0)))
                        (pprint-logical-block (*standard-output* '(1) :suffix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.3
  (check-type-error #'(lambda (x)
                        (pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.3-unsafe
  (check-type-error #'(lambda (x)
                        (declare (optimize (safety 0)))
                        (pprint-logical-block (*standard-output* '(1) :per-line-prefix x)))
                    #'stringp)
  nil)

(deftest pprint-logical-block.error.4
  (signals-error (with-standard-io-syntax
                  (let ((*print-pretty* t)
                        (*print-right-margin* 100)
                        (*print-readably* nil)
                        (val '(7)))
                    (pprint-logical-block (os val :prefix "" :per-line-prefix "")
                                          (write (car val) :stream os))))
                 error)
  t)

(deftest pprint-logical-block.error.4-unsafe
  (signals-error (with-standard-io-syntax
                  (let ((*print-pretty* t)
                        (*print-right-margin* 100)
                        (*print-readably* nil)
                        (val '(7)))
                    (pprint-logical-block (os val :prefix "" :per-line-prefix "")
                                          (write (car val) :stream os))))
                 error
                 :safety 0)
  t)