cs: adjust some core tests

This commit is contained in:
Matthew Flatt 2019-01-20 20:00:23 -07:00
parent fdb98da0b1
commit fa448c5748
2 changed files with 12 additions and 5 deletions

View File

@ -10,14 +10,18 @@
(struct ts (a))
(err/rt-test (place-channel-put in (ts "k")))
(define places-share-symbols?
(or (not (place-enabled?))
(eq? 'chez-scheme (system-type 'vm))))
(let ()
(define us (string->uninterned-symbol "foo"))
(define us2 (string->uninterned-symbol "foo"))
(place-channel-put in (cons us us))
(define r (place-channel-get out))
(test #t equal? (car r) (cdr r))
(test (not (place-enabled?)) equal? us (car r))
(test (not (place-enabled?)) equal? us (cdr r))
(test places-share-symbols? equal? us (car r))
(test places-share-symbols? equal? us (cdr r))
(test #f symbol-interned? (car r))
(test #f symbol-interned? (cdr r))
@ -26,8 +30,8 @@
(test #f symbol-interned? (car r2))
(test #f symbol-interned? (cdr r2))
(test #f equal? (car r2) (cdr r2))
(test (not (place-enabled?)) equal? us (car r2))
(test (not (place-enabled?)) equal? us2 (cdr r2)))
(test places-share-symbols? equal? us (car r2))
(test places-share-symbols? equal? us2 (cdr r2)))
(let ()
(define us (string->unreadable-symbol "foo2"))

View File

@ -423,7 +423,10 @@
;;----------------------------------------
;; Check continuation sharing
(let ()
;; This check is useful for the traditional Racket VM, but it isn't as
;; interesting on Chez Scheme --- where the sharing is more obvious in
;; the implementation but not exposed as `eq?` continuations
(when (eq? 'racket (system-type 'vm))
(define (f x prev)
(call/cc
(lambda (k)