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