From b8b25c8829bafbdc09dd91a3d5bf6db048d87d39 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 2 Dec 2018 01:55:45 +0000 Subject: [PATCH] Fix find-shared-objects. pp is still busted. --- src/runtime/printer.scm | 8 +++++--- tests/runtime/test-printer.scm | 6 ++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm index aead849a8..3cea685fd 100644 --- 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 e95d97152..b0e3ffd7a 100644 --- 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))))) -- 2.25.1