;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Apr 20 22:36:53 2004
;;;; Contains: Tests of vector printing



(in-package :cl-test)

;;; Empty vector tests

(deftest print.vector.1
  (with-standard-io-syntax
   (write-to-string #() :readably nil :array t))
  "#()")

(deftest print.vector.2
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for a = (make-array '(0) :element-type `(unsigned-byte ,i))
         for s = (write-to-string a :readably nil :array t :pretty nil)
         unless (string= s "#()")
         collect (list i s)))
  nil)

(deftest print.vector.3
  (with-standard-io-syntax
   (loop for i from 1 to 100
         for a = (make-array '(0) :element-type `(signed-byte ,i))
         for s = (write-to-string a :readably nil :array t :pretty nil)
         unless (string= s "#()")
         collect (list i s)))
  nil)

(deftest print.vector.4
  (with-standard-io-syntax
   (loop for type in '(short-float single-float double-float long-float)
         for a = (make-array '(0) :element-type type)
         for s = (write-to-string a :readably nil :array t :pretty nil)
         unless (string= s "#()")
         collect (list type s)))
  nil)

;;; Nonempty vectors

(deftest print.vector.5
  (with-standard-io-syntax
   (let* ((*package* (find-package "CL-TEST"))
          (result
           (write-to-string #(a b c)
                            :readably nil :array t
                            :pretty nil :case :downcase)))
     (or (and (string= result "#(a b c)") t)
         result)))
  t)

(deftest print.vector.6
  (with-standard-io-syntax
   (loop
    for i from 2 to 100
    for a = (make-array '(4) :element-type `(unsigned-byte ,i)
                        :initial-contents '(3 0 2 1))
    for s = (write-to-string a :readably nil :array t :pretty nil)
    unless (string= s "#(3 0 2 1)")
    collect (list i a s)))
  nil)

(deftest print.vector.7
  (with-standard-io-syntax
   (loop
    for i from 2 to 100
    for a = (make-array '(4) :element-type `(signed-byte ,i)
                        :initial-contents '(-2 -1 0 1))
    for s = (write-to-string a :readably nil :array t :pretty nil)
    unless (string= s "#(-2 -1 0 1)")
    collect (list i a s)))
  nil)

;;; Vectors with fill pointers

(deftest print.vector.fill.1
  (with-standard-io-syntax
   (let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
                        :fill-pointer 0))
         (*package* (find-package "CL-TEST")))
     (loop for i from 0 to 10
           do (setf (fill-pointer v) i)
           collect (write-to-string v :readably nil :array t :pretty nil
                                    :case :downcase))))
  ("#()"
   "#(a)"
   "#(a b)"
   "#(a b c)"
   "#(a b c d)"
   "#(a b c d e)"
   "#(a b c d e f)"
   "#(a b c d e f g)"
   "#(a b c d e f g h)"
   "#(a b c d e f g h i)"
   "#(a b c d e f g h i j)"))

(deftest print.vector.fill.2
  (with-standard-io-syntax
   (let ((expected '("#()" "#(0)" "#(0 1)" "#(0 1 2)" "#(0 1 2 3)")))
     (loop for i from 2 to 100
           nconc
           (let ((v (make-array '(4) :initial-contents '(0 1 2 3)
                                :element-type `(unsigned-byte ,i)
                                :fill-pointer 0)))
             (loop for fp from 0 to 4
                   for expected-result in expected
                   for actual-result =
                   (progn
                     (setf (fill-pointer v) fp)
                     (write-to-string v :readably nil :array t :pretty nil))
                   unless (string= expected-result actual-result)
                   collect (list i fp expected-result actual-result))))))
  nil)

(deftest print.vector.fill.3
  (with-standard-io-syntax
   (let ((expected '("#()" "#(0)" "#(0 -1)" "#(0 -1 -2)" "#(0 -1 -2 1)")))
     (loop for i from 2 to 100
           nconc
           (let ((v (make-array '(4) :initial-contents '(0 -1 -2 1)
                                :element-type `(signed-byte ,i)
                                :fill-pointer 0)))
             (loop for fp from 0 to 4
                   for expected-result in expected
                   for actual-result =
                   (progn
                     (setf (fill-pointer v) fp)
                     (write-to-string v :readably nil :array t :pretty nil))
                   unless (string= expected-result actual-result)
                   collect (list i fp expected-result actual-result))))))
  nil)

;;; Displaced vectors

(deftest print.vector.displaced.1
  (let* ((v1 (vector 'a 'b 'c 'd 'e 'f 'g))
         (v2 (make-array 3 :displaced-to v1 :displaced-index-offset 4)))
    (with-standard-io-syntax
     (write-to-string v2 :readably nil :array t :case :downcase :pretty nil
                      :escape nil)))
  "#(e f g)")

(deftest print.vector.displaced.2
  (with-standard-io-syntax
   (loop for i from 2 to 100
         nconc
         (let* ((type `(unsigned-byte ,i))
                (v1 (make-array 8 :element-type type
                                :initial-contents '(0 1 2 3 0 1 2 3)))
                (v2 (make-array 5 :displaced-to v1
                                :displaced-index-offset 2
                                :element-type type))
                (result
                 (write-to-string v2 :readably nil :array t :pretty nil)))
           (unless (string= result "#(2 3 0 1 2)")
             (list (list i v1 v2 result))))))
  nil)


(deftest print.vector.displaced.3
  (with-standard-io-syntax
   (loop for i from 2 to 100
         nconc
         (let* ((type `(signed-byte ,i))
                (v1 (make-array 8 :element-type type
                                :initial-contents '(0 1 -1 -2 0 1 -1 -2)))
                (v2 (make-array 5 :displaced-to v1
                                :displaced-index-offset 2
                                :element-type type))
                (result
                 (write-to-string v2 :readably nil :array t :pretty nil)))
           (unless (string= result "#(-1 -2 0 1 -1)")
             (list (list i v1 v2 result))))))
  nil)


;;; Adjustable vectors

(deftest print.vector.adjustable.1
  (with-standard-io-syntax
   (let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
                        :adjustable t)))
     (write-to-string v :readably nil :array t :case :downcase :pretty nil
                      :escape nil)))
  "#(a b c d e f g h i j)")

(deftest print.vector.adjustable.2
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(8) :initial-contents '(0 1 2 3 3 0 2 1)
                             :adjustable t)
         for s =
         (write-to-string v :readably nil :array t :case :downcase :pretty nil
                          :escape nil)
         unless (string= s "#(0 1 2 3 3 0 2 1)")
         collect (list i v s)))
  nil)

(deftest print.vector.adjustable.3
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(signed-byte ,i)
         for v = (make-array '(8) :initial-contents '(0 1 -1 -2 -1 0 -2 1)
                             :adjustable t)
         for s =
         (write-to-string v :readably nil :array t :case :downcase :pretty nil
                          :escape nil)
         unless (string= s "#(0 1 -1 -2 -1 0 -2 1)")
         collect (list i v s)))
  nil)

;;; Printing with *print-array* and *print-readably* bound to nil

(deftest print.vector.unreadable.1
  (with-standard-io-syntax
   (subseq (write-to-string #(a b c d e) :array nil :readably nil) 0 2))
  "#<")

(deftest print.vector.unreadable.2
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(0 1 2 3))
         for result = (write-to-string v :array nil :readably nil)
         unless (string= (subseq result 0 2) "#<")
         collect (list i type v result)))
  nil)


(deftest print.vector.unreadable.3
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(signed-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(0 1 -2 -1))
         for result = (write-to-string v :array nil :readably nil)
         unless (string= (subseq result 0 2) "#<")
         collect (list i type v result)))
  nil)

;;; Readability tests

(deftest print.vector.random.1
  (trim-list
   (loop for v in *universe*
         when (vectorp v)
         nconc
         (loop repeat 10
               nconc (randomly-check-readability
                      v :test #'equalp
                      :can-fail (not (subtypep t (array-element-type v))))))
   10)
  nil)

(deftest print.vector.random.2
  (trim-list
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(1 3 2 0))
         nconc
         (loop repeat 10
               nconc (randomly-check-readability v :test #'equalp
                                                 :can-fail t)))
   10)
  nil)

(deftest print.vector.random.3
  (trim-list
   (loop for i from 2 to 100
         for type = `(signed-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(-1 1 0 -2))
         nconc
         (loop repeat 10
               nconc (randomly-check-readability v :test #'equalp
                                                 :can-fail t)))
   10)
  nil)

(deftest print.vector.random.4
  (trim-list
   (loop for v = (make-random-vector (1+ (random 100)))
         repeat 1000
         nconc (randomly-check-readability v :test #'equalp))
   10)
  nil)

;;; *print-length* checks

(deftest print.vector.length.1
  (with-standard-io-syntax
   (write-to-string #() :pretty nil :length 0 :readably nil))
  "#()")

(deftest print.vector.length.2
  (with-standard-io-syntax
   (write-to-string #(1) :pretty nil :length 0 :readably nil))
  "#(...)")

(deftest print.vector.length.3
  (with-standard-io-syntax
   (write-to-string #(1) :pretty nil :length 1 :readably nil))
  "#(1)")

(deftest print.vector.length.4
  (with-standard-io-syntax
   (write-to-string #(a b c d e f g h)
                    :pretty nil
                    :array t :escape nil
                    :length 5 :case :downcase
                    :readably nil))
  "#(a b c d e ...)")

(deftest print.vector.length.5
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(0) :element-type type)
         for result = (write-to-string v :array t :readably nil
                                       :pretty nil
                                       :length 0)
         unless (string= result "#()")
         collect (list i type v result)))
  nil)

(deftest print.vector.length.6
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(1) :element-type type :initial-contents '(2))
         for result = (write-to-string v
                                       :pretty nil
                                       :array t
                                       :readably nil
                                       :length 0)
         unless (string= result "#(...)")
         collect (list i type v result)))
  nil)

(deftest print.vector.length.7
  (with-standard-io-syntax
   (loop for i from 1 to 100
         for type = `(signed-byte ,i)
         for v = (make-array '(1) :element-type type :initial-contents '(-1))
         for result = (write-to-string v
                                       :pretty nil
                                       :array t
                                       :readably nil
                                       :length 0)
         unless (string= result "#(...)")
         collect (list i type v result)))
  nil)

(deftest print.vector.length.8
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(unsigned-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(1 3 0 2))
         for result = (write-to-string v
                                       :pretty nil
                                       :array t
                                       :readably nil
                                       :length 2)
         unless (string= result "#(1 3 ...)")
         collect (list i type v result)))
  nil)

(deftest print.vector.length.9
  (with-standard-io-syntax
   (loop for i from 2 to 100
         for type = `(signed-byte ,i)
         for v = (make-array '(4) :element-type type
                             :initial-contents '(1 -2 0 -1))
         for result = (write-to-string v
                                       :pretty nil
                                       :array t
                                       :readably nil
                                       :length 2)
         unless (string= result "#(1 -2 ...)")
         collect (list i type v result)))
  nil)

;;; Printing with *print-level* bound

(deftest print.vector.level.1
  (with-standard-io-syntax
   (write-to-string #() :level 0 :readably nil :pretty nil))
  "#")

(deftest print.vector.level.2
  (with-standard-io-syntax
   (write-to-string #() :level 1 :readably nil :pretty nil))
  "#()")

(deftest print.vector.level.3
  (with-standard-io-syntax
   (write-to-string #(17) :level 1 :readably nil :pretty nil))
  "#(17)")

(deftest print.vector.level.4
  (with-standard-io-syntax
   (write-to-string #(4 (17) 9 (a) (b) 0) :level 1 :readably nil :pretty nil))
  "#(4 # 9 # # 0)")

(deftest print.vector.level.5
  (with-standard-io-syntax
   (write-to-string '(#(a)) :level 1 :readably nil :pretty nil))
  "(#)")

(deftest print.vector.level.6
  (with-standard-io-syntax
   (write-to-string '#(#(a)) :level 1 :readably nil :pretty nil))
  "#(#)")

;;; Printing with *print-circle* bound

(deftest print.vector.circle.1
  (let ((vector (vector 25 26 27)))
    (setf (aref vector 2) vector)
    (with-standard-io-syntax
      (write-to-string vector :circle t :readably nil :pretty nil)))
  "#1=#(25 26 #1#)")