From 72e1f77b85c75518dcd2e5ee3afd9469ca99928b Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 12 Jul 2004 11:48:35 +0000
Subject: [PATCH] Add tests for print-unreadable-object

---
 ansi-tests/load-printer.lsp            |   1 +
 ansi-tests/print-unreadable-object.lsp | 135 +++++++++++++++++++++++++
 2 files changed, 136 insertions(+)
 create mode 100644 ansi-tests/print-unreadable-object.lsp

diff --git a/ansi-tests/load-printer.lsp b/ansi-tests/load-printer.lsp
index 11d2e520..f48610b8 100644
--- a/ansi-tests/load-printer.lsp
+++ b/ansi-tests/load-printer.lsp
@@ -34,3 +34,4 @@
 (load "pprint-exit-if-list-exhausted.lsp")
 (load "pprint-newline.lsp")
 (load "pprint-tab.lsp")
+(load "print-unreadable-object.lsp")
diff --git a/ansi-tests/print-unreadable-object.lsp b/ansi-tests/print-unreadable-object.lsp
new file mode 100644
index 00000000..919fd83a
--- /dev/null
+++ b/ansi-tests/print-unreadable-object.lsp
@@ -0,0 +1,135 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Mon Jul 12 06:06:01 2004
+;;;; Contains: Tests of PRINT-UNREADABLE-OBJECT
+
+(in-package :cl-test)
+
+(compile-and-load "printer-aux.lsp")
+
+(def-pprint-test print-unreadable-object.1
+  (loop
+   for x in *mini-universe*
+   for return-vals = nil
+   for s = (with-output-to-string
+	     (s)
+	     (setq return-vals
+		   (multiple-value-list (print-unreadable-object (x s)))))
+   unless (and (equal return-vals '(nil))
+	       (equal s "#<>"))
+   collect (list x return-vals s))
+  nil)
+
+(def-pprint-test print-unreadable-object.2
+  (loop
+   for x in *mini-universe*
+   for return-vals1 = nil
+   for return-vals2 = nil
+   for s1 = (with-output-to-string
+	      (s)
+	      (setq return-vals1
+		    (multiple-value-list (print-unreadable-object
+					  (x s :type t)))))
+   for s2 = (with-output-to-string
+	      (s)
+	      (setq return-vals2
+		    (multiple-value-list (print-unreadable-object
+					  (x s :type t)
+					  (write-char #\X s)))))
+   unless (and (equal return-vals1 '(nil))
+	       (equal return-vals2 '(nil))
+	       (string= s1 "#<" :end1 2)
+	       (string= s1 s2 :end1 (- (length s1) 1)
+			:end2 (- (length s2) 2))
+	       (string= s2 " X>" :start1 (- (length s2) 3)))
+   collect (list x return-vals1 return-vals2 s1 s2))
+  nil)
+
+(def-pprint-test print-unreadable-object.3
+  (loop
+   for x in *mini-universe*
+   for return-vals1 = nil
+   for return-vals2 = nil
+   for s1 = (with-output-to-string
+	      (s)
+	      (setq return-vals1
+		    (multiple-value-list (print-unreadable-object
+					  (x s :identity t)
+					  (write "FOO" :stream s)
+					  (values 1 2 3 4 5) ;; test if this is ignored
+					  ))))
+   for s2 = (with-output-to-string
+	      (s)
+	      (setq return-vals2
+		    (multiple-value-list (print-unreadable-object
+					  (x s :identity t)
+					  ))))
+   unless (and (equal return-vals1 '(nil))
+	       (equal return-vals2 '(nil))
+	       (string= s1 "#<FOO " :end1 6)
+	       (string= s2 "#< " :end1 3)
+	       (eql (char s1 (1- (length s1))) #\>)
+	       (eql (char s2 (1- (length s2))) #\>)
+	       (string= s1 s2 :start2 3 :start1 6))
+   collect (list x return-vals1 return-vals2 s1 s2))
+  nil)
+
+(def-pprint-test print-unreadable-object.4
+  (loop
+   for x in *mini-universe*
+   for return-vals1 = nil
+   for s = (with-output-to-string
+	     (s)
+	     (setq return-vals
+		   (multiple-value-list (print-unreadable-object
+					 (x s :identity t :type t)
+					 (write "FOO" :stream s)
+					 (values) ;; test if this is ignored
+					 ))))
+   unless (and (equal return-vals '(nil))
+	       (string= s "#<" :end1 2)
+	       (eql (char s (1- (length s))) #\>)
+	       (>= (count #\Space s) 2))
+   collect (list x return-vals s))
+  nil)
+
+;;; Error cases
+
+(deftest print-unreadable-object.error.1
+  (with-standard-io-syntax
+   (let ((*print-readably* t))
+     (loop for x in *mini-universe*
+	   for form = `(with-output-to-string
+			 (*standard-output*)
+			 (assert (signals-error
+				  (print-unreadable-object (',x *standard-output*))
+				  print-not-readable)))
+	   unless (equal (eval form) "")
+	   collect x)))
+  nil)
+
+;;; Stream designators
+
+(deftest print-unreadable-object.t.1
+  (with-output-to-string
+    (os)
+    (with-input-from-string
+     (is "")
+     (with-open-stream
+      (*terminal-io* (make-two-way-stream is os))
+      (let ((*print-readably* nil))
+	(assert
+	 (equal (multiple-value-list (print-unreadable-object (1 t)))
+		'(nil)))))))
+  "#<>")
+
+(deftest print-unreadable-object.nil.1
+  (with-output-to-string
+    (*standard-output*)
+    (let ((*print-readably* nil))
+      (assert
+       (equal (multiple-value-list (print-unreadable-object (1 nil)))
+	      '(nil)))))
+  "#<>")
+
+
-- 
GitLab