From 23378d164a6670d1773cafbf401ce2ca044c2053 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 9 Aug 2004 11:45:41 +0000
Subject: [PATCH] Forgot to check this in.

---
 ansi-tests/print-length.lsp | 136 ++++++++++++++++++++++++++++++++++++
 1 file changed, 136 insertions(+)
 create mode 100644 ansi-tests/print-length.lsp

diff --git a/ansi-tests/print-length.lsp b/ansi-tests/print-length.lsp
new file mode 100644
index 00000000..e4470871
--- /dev/null
+++ b/ansi-tests/print-length.lsp
@@ -0,0 +1,136 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Tue Jul 27 08:27:37 2004
+;;;; Contains: Tests involving *PRINT-LENGTH*
+
+(in-package :cl-test)
+
+(compile-and-load "printer-aux.lsp")
+
+(def-print-test print-length.1
+  '(1)
+  "(...)"
+  (*print-length* 0))
+
+(def-print-test print-length.2
+  '(1)
+  "(1)"
+  (*print-length* nil))
+
+(def-print-test print-length.3
+  '(1)
+  "(1)"
+  (*print-length* 1))
+
+(def-print-test print-length.4
+  '(1 . 2)
+  "(1 . 2)"
+  (*print-length* 1))
+
+(deftest print-length.5
+  (let ((x '(|A| |B| |C| |D| |E| |F|)))
+    (with-standard-io-syntax
+     (let ((*print-case* :upcase)
+	   (*print-escape* nil)
+	   (*print-readably* nil)
+	   (*print-pretty* nil)
+	   (*print-length* nil))
+       (apply
+	#'values
+	(loop for i from 0 to 8
+	      collect (let ((*print-length* i))
+			(write-to-string x)))))))
+  "(...)"
+  "(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)"
+  "(A B C D E F)")
+
+(deftest print-length.6
+  (let ((x '(|A| |B| |C| |D| |E| |F| . |G|)))
+    (with-standard-io-syntax
+     (let ((*print-case* :upcase)
+	   (*print-escape* nil)
+	   (*print-readably* nil)
+	   (*print-pretty* nil)
+	   (*print-length* nil))
+       (apply
+	#'values
+	(loop for i from 0 to 8
+	      collect (let ((*print-length* i))
+			(write-to-string x)))))))
+  "(...)"
+  "(A ...)"
+  "(A B ...)"
+  "(A B C ...)"
+  "(A B C D ...)"
+  "(A B C D E ...)"
+  "(A B C D E F . G)"
+  "(A B C D E F . G)"
+  "(A B C D E F . G)")
+
+(def-print-test print-length.7
+  '(1)
+  "(1)"
+  (*print-length* (1+ most-positive-fixnum)))
+
+(deftest print-length.8
+  (let ((x #(|A| |B| |C| |D| |E| |F|)))
+    (with-standard-io-syntax
+     (let ((*print-case* :upcase)
+	   (*print-escape* nil)
+	   (*print-readably* nil)
+	   (*print-pretty* nil)
+	   (*print-length* nil))
+       (apply
+	#'values
+	(loop for i from 0 to 8
+	      collect (let ((*print-length* i))
+			(write-to-string x)))))))
+  "#(...)"
+  "#(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)"
+  "#(A B C D E F)")
+
+(def-print-test print-length.9
+  "A modest sentence with six words."
+  "\"A modest sentence with six words.\""
+  (*print-length* 0))
+
+(def-print-test print-length.10
+  #*00110101100011
+  "#*00110101100011"
+  (*print-length* 0))
+
+(defstruct print-length-struct foo)
+
+;;; The next test tacitly assumes issue STRUCTURE-READ-PRINT-SYNTAX
+
+(deftest print-length.11
+  (with-standard-io-syntax
+   (let ((*print-case* :upcase)
+	 (*print-escape* nil)
+	 (*print-readably* nil)
+	 (*print-pretty* nil)
+	 (*print-length* nil)
+	 (*package* (find-package "CL-TEST"))
+	 (s (make-print-length-struct :foo 17)))
+     (apply
+	#'values
+	(loop for i from 0 to 4
+	      collect (let ((*print-length* i))
+			(write-to-string s))))))
+  "#S(...)"
+  "#S(PRINT-LENGTH-STRUCT ...)"
+  "#S(PRINT-LENGTH-STRUCT :FOO ...)"
+  "#S(PRINT-LENGTH-STRUCT :FOO 17)"
+  "#S(PRINT-LENGTH-STRUCT :FOO 17)")
-- 
GitLab