diff --git a/ansi-tests/print-vector.lsp b/ansi-tests/print-vector.lsp index dd11abdaf598c675de04b99a7da7a83deff35361..0b15cafeaef0628d4ee5a49d29c6c47f6a5a77fb 100644 --- a/ansi-tests/print-vector.lsp +++ b/ansi-tests/print-vector.lsp @@ -3,6 +3,8 @@ ;;;; Created: Tue Apr 20 22:36:53 2004 ;;;; Contains: Tests of vector printing +(compile-and-load "printer-aux.lsp") + (in-package :cl-test) ;;; Empty vector tests @@ -74,4 +76,332 @@ 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 + (loop for v in *universe* + when (vectorp v) + nconc + (loop repeat 10 + nconc (randomly-check-readability v :test #'equalp))) + nil) + +(deftest print.vector.random.2 + (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))) + nil) + +(deftest print.vector.random.3 + (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))) + 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 (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 (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 (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 (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 (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)) + "#(#)") + +