diff options
| author | Peter Bex <peter@more-magic.net> | 2025-08-18 14:29:48 +0200 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2025-08-18 14:29:48 +0200 |
| commit | 66eb53e611256a163a0ff4623b889a8382948305 (patch) | |
| tree | 2d40b420dfb82e630c668967e27d558dc13b574c | |
| parent | a64d4e18ade6e0eca23806524f863852594f229d (diff) | |
| download | slset-66eb53e611256a163a0ff4623b889a8382948305.tar.gz | |
Allow with-reified-slset to return values as well
Otherwise, it'll be a bit awkward if we do have something more useful
to return. And we wouldn't be able to get at the slset's list so
easily.
| -rw-r--r-- | slsets.scm | 4 | ||||
| -rw-r--r-- | tests/run.scm | 53 |
2 files changed, 30 insertions, 27 deletions
@@ -191,8 +191,8 @@ (dynamic-wind (lambda () (mark-list! (reified-slset-list rs) marking)) (lambda () - (fun rs) - (reified-slset-list rs)) + (receive res (fun rs) + (apply values (reified-slset-list rs) res))) (lambda () (unmark-list! (reified-slset-list rs) marking))))) (define (reified-slset-adjoin! rs . els) diff --git a/tests/run.scm b/tests/run.scm index 571a7fe..f9a47ea 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -157,32 +157,35 @@ (test-assert (clean? all-symbols))) (test-group "reified slsets" - (let ((result (with-reified-slset '(a b c d a c e) - (lambda (r) - (test #t (reified-slset-contains? r 'a)) - (test #t (reified-slset-contains? r 'b)) - (test #t (reified-slset-contains? r 'e)) - (test #f (reified-slset-contains? r 'i)) - (test #f (reified-slset-contains? r 'x)) - - (reified-slset-delete! r 'b) - (test '(a c d a c e) - (reified-slset->slset r)) - - (reified-slset-adjoin! r 'x) - (test #t (reified-slset-contains? r 'x)) - - (reified-slset-delete! r 'a 'e 'i) - (test '(x c d c) - (reified-slset->slset r)) - - ;; Extra check to ensure we unmark these - (test #f (reified-slset-contains? r 'a)) - - ;; Basic sanity check, remaining contents still in there - (test #t (reified-slset-contains? r 'c)))))) + (let-values ((result (with-reified-slset '(a b c d a c e) + (lambda (r) + (test #t (reified-slset-contains? r 'a)) + (test #t (reified-slset-contains? r 'b)) + (test #t (reified-slset-contains? r 'e)) + (test #f (reified-slset-contains? r 'i)) + (test #f (reified-slset-contains? r 'x)) + + (reified-slset-delete! r 'b) + (test '(a c d a c e) + (reified-slset->slset r)) + + (reified-slset-adjoin! r 'x) + (test #t (reified-slset-contains? r 'x)) + + (reified-slset-delete! r 'a 'e 'i) + (test '(x c d c) + (reified-slset->slset r)) + + ;; Extra check to ensure we unmark these + (test #f (reified-slset-contains? r 'a)) + + ;; Basic sanity check, remaining contents still in there + (test #t (reified-slset-contains? r 'c)) + + ;; Return values + (values 1 2 3))))) ;; Put it in an extra list to avoid test form complaining - (test '((x c d c)) (list result))) + (test '(((x c d c) 1 2 3)) (list result))) (test-group "all symbols used here still clean" (test-assert (clean? '(a b c d e i x)))))) |