Fix find-shared-objects. pp is still busted.

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index aead849a838a5afd1353478303e794514a9de84a..3cea685fd742f4c37373558492706c29fcdf0705 100644 (file)
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -270,9 +270,11 @@ USA.
 
     (define (mark! object)
       (let ((value
-            (case (hash-table-ref/default table object 'unseen)
-              ((unseen) 'seen)
-              ((seen) 'shared))))
+            (let ((value (hash-table-ref/default table object 'unseen)))
+              (case value
+                ((unseen) 'seen)
+                ((seen shared) 'shared)
+                (else (error "Invalid sharing state:" value))))))
        (hash-table-set! table object value)
        (eq? 'seen value)))
 

diff --git a/tests/runtime/test-printer.scm b/tests/runtime/test-printer.scm
index e95d971524523c63564924c52ddd1b357a11d80b..b0e3ffd7ab0251dd9ff176b127430da9d537989a 100644 (file)
--- a/tests/runtime/test-printer.scm
+++ b/tests/runtime/test-printer.scm
@@ -43,7 +43,5 @@ USA.
       (set-car! c c)
       (set-cdr! c c)
       (let ((s (find-shared-objects c)))
-        (expect-failure
-         (lambda ()
-           (assert-= (length s) 1)
-           (assert-eq (car s) c)))))))
+        (assert-= (length s) 1)
+        (assert-eq (car s) c)))))