From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 2 Dec 2018 03:29:16 +0000 (+0000)
Subject: pp doesn't respect custom print methods for tagged vectors.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~54
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5691dfef97cbe86fd49b0ac51c40b7d33b1682bc;p=mit-scheme.git

pp doesn't respect custom print methods for tagged vectors.
---

diff --git a/tests/runtime/test-pp.scm b/tests/runtime/test-pp.scm
index 9b84ff223..6ccd930ad 100644
--- a/tests/runtime/test-pp.scm
+++ b/tests/runtime/test-pp.scm
@@ -105,3 +105,23 @@ USA.
        ;; XXX Figure out what string it should print by hand.
        (assert-string
         (carefully doit (lambda () 'stack-overflow) (lambda () 'timeout)))))))
+
+(define-test 'custom
+  (lambda ()
+    (expect-failure
+     (lambda ()
+       (let ((tag (cons 0 0)))
+         (define (loser? object)
+           (and (vector? object)
+                (<= 1 (vector-length object))
+                (eq? tag (vector-ref object 0))))
+         (register-predicate! loser? 'loser? '<= vector?)
+         (define-print-method loser?
+           (standard-print-method
+            (lambda (object) object "LOSER")
+            (lambda (object) object '(42))))
+         (let* ((loser (make-vector 1000 tag))
+                (hash (number->string (hash-object loser))))
+           (assert-equal
+            (call-with-output-string (lambda (port) (pp loser port)))
+            (string-append "#[LOSER " hash " 42]\n"))))))))