;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jul  6 06:11:01 2004
;;;; Contains: Tests of PPRINT-EXIT-IF-LIST-EXHAUSTED, PPRINT-POP

(in-package :cl-test)

(deftest pprint-exit-if-list-exhausted.1
  (with-standard-io-syntax
   (let ((*print-pretty* nil)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write #\Space :stream os)
        (write (pprint-pop) :stream os)
        (pprint-exit-if-list-exhausted)
        (assert nil)))))
  "1 2")

(deftest pprint-exit-if-list-exhausted.2
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write #\Space :stream os)
        (write (pprint-pop) :stream os)
        (pprint-exit-if-list-exhausted)
        (assert nil)))))
  "1 2")

(deftest pprint-exit-if-list-exhausted.3
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1 . 2))
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (write #\Space :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (pprint-pop)
        (assert nil)))))
  "1 . 2")

(deftest pprint-exit-if-list-exhausted.4
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         )
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1 . 2) :prefix "[" :suffix "]")
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (write (pprint-pop) :stream os)
        (write #\Space :stream os)
        (assert (equal (multiple-value-list
                        (pprint-exit-if-list-exhausted))
                       '(nil)))
        (pprint-pop)
        (assert nil)))))
  "[1 . 2]")

;;; Tests focusing on pprint-pop

(deftest pprint-pop.1
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os nil)
        (pprint-pop)
        (assert nil)))))
  "...")

(deftest pprint-pop.2
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os 1)
        (pprint-pop)))))
  "1")

(deftest pprint-pop.3
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 1))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1))
        (assert (equal '(1) (multiple-value-list (pprint-pop))))))))
  "")

(deftest pprint-pop.4
  (with-standard-io-syntax
   (let ((*print-pretty* t)
         (*print-escape* nil)
         (*print-right-margin* 100)
         (*print-readably* nil)
         (*print-length* 0))
     (with-output-to-string
       (os)
       (pprint-logical-block
        (os '(1 2 3) :prefix "{" :suffix "}")
        (pprint-pop)
        (assert nil)))))
  "{...}")

(deftest pprint-pop.5
  (flet ((%f (len)
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os '(1 2 3 4 5) :prefix "{" :suffix "}")
                   (pprint-exit-if-list-exhausted)
                   (write (pprint-pop) :stream os)
                   (loop (pprint-exit-if-list-exhausted)
                         (write #\Space :stream os)
                         (write (pprint-pop) :stream os))))))))
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4) (%f 5) (%f 6)))
  "{...}"
  "{1 ...}"
  "{1 2 ...}"
  "{1 2 3 ...}"
  "{1 2 3 4 ...}"
  "{1 2 3 4 5}"
  "{1 2 3 4 5}")

(deftest pprint-pop.6
  (flet ((%f (len)
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os '(1 2 . 3) :prefix "{" :suffix "}")
                   (pprint-exit-if-list-exhausted)
                   (write (pprint-pop) :stream os)
                   (loop (pprint-exit-if-list-exhausted)
                         (write #\Space :stream os)
                         (write (pprint-pop) :stream os))))))))
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "{...}"
  "{1 ...}"
  "{1 2 . 3}"
  "{1 2 . 3}"
  "{1 2 . 3}")

;;; pprint-pop and circularity/sharing

(deftest pprint-pop.7
  (flet ((%f (len)
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len)
                    (*print-circle* t))
                (with-output-to-string
                  (os)
                  (let* ((tail (list 1))
                         (x (list* tail 2 tail)))
                    (pprint-logical-block
                     (os x :prefix "<" :suffix ">")
                     (pprint-exit-if-list-exhausted)
                     (write (pprint-pop) :stream os)
                     (loop (pprint-exit-if-list-exhausted)
                           (write #\Space :stream os)
                           (write (pprint-pop) :stream os)))))))))
    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "<#1=(1) 2 . #1#>"
  "<...>"
  "<(1) ...>"
  "<(1) 2 ...>"
  "<#1=(1) 2 . #1#>"
  "<#1=(1) 2 . #1#>")

(deftest pprint-pop.8
  (flet ((%f (len)
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len)
                    (*print-circle* t))
                (with-output-to-string
                  (os)
                  (let* ((tail (list 2))
                         (x (list* 1 tail)))
                    (setf (cdr tail) tail)
                    (pprint-logical-block
                     (os x :prefix "[[" :suffix "]]")
                     (pprint-exit-if-list-exhausted)
                     (write (pprint-pop) :stream os)
                     (loop (pprint-exit-if-list-exhausted)
                           (write #\Space :stream os)
                           (write (pprint-pop) :stream os)))))))))
    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 10) (%f 20)))
  "[[...]]"
  "[[1 ...]]"
  "[[1 2 ...]]"
  "[[1 . #1=(2 . #1#)]]"
  "[[1 . #1=(2 . #1#)]]"
  "[[1 . #1=(2 . #1#)]]")

;;; pprint-pop when pprint-logical-block is given NIL

(deftest pprint-pop.9
  (flet ((%f (len)
             (with-standard-io-syntax
              (let ((*print-pretty* t)
                    (*print-escape* nil)
                    (*print-right-margin* 100)
                    (*print-readably* nil)
                    (*print-length* len))
                (with-output-to-string
                  (os)
                  (pprint-logical-block
                   (os nil :prefix "{" :suffix "}")
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "First call returned ~A" vals))
                   (write 1 :stream os)
                   (write #\Space :stream os)
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "Second call returned ~A" vals))
                   (write 2 :stream os)
                   (write #\Space :stream os)
                   (let ((vals (multiple-value-list (pprint-pop))))
                     (assert (equal vals '(nil)) () "Third call returned ~A" vals))
                   (write 3 :stream os)
                   ))))))
    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
  "{1 2 3}"
  "{...}"
  "{1 ...}"
  "{1 2 ...}"
  "{1 2 3}"
  "{1 2 3}")

;;; Error cases

(deftest pprint-exit-if-list-exhausted.error.1
  (signals-error (pprint-exit-if-list-exhausted) error)
  t)

(deftest pprint-exit-if-list-exhausted.error.1-unsafe
  (locally (declare (optimize (safety 0)))
           (signals-error (locally (declare (optimize (safety 0)))
                                   (pprint-exit-if-list-exhausted))
                          error))
  t)

(deftest pprint-pop.error.1
  (signals-error (pprint-pop) error)
  t)


(deftest pprint-pop.error.1-unsafe
  (locally (declare (optimize (safety 0)))
           (signals-error (locally (declare (optimize (safety 0))) (pprint-pop)) error))
  t)