suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Guard free-identifier=? comparisons in shared. (#2382)

Browse Source 
Fixes #2381.
This commit is contained in:
Sam Tobin-Hochstadt 2018-11-17 22:26:11 -05:00 committed by GitHub
parent c4189ff934
commit c1d2e4031e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-test-core/tests/racket/shared.rktl
View File

@ -49,4 +49,6 @@
(test an-a 'an-a (shared ([t (a 1 t)]) (test an-a 'an-a (shared ([t (a 1 t)])
t))) t)))
(test 42 values (shared ((b ((thunk 42)))) b))
(test 42 unbox (shared ((b (box-immutable ((thunk 42))))) b))
(report-errs) (report-errs)

26
racket/collects/racket/private/shared-body.rkt
View File

@ -76,18 +76,20 @@
[same-special-id? (lambda (a b) [same-special-id? (lambda (a b)
;; Almost module-or-top-identifier=?, ;; Almost module-or-top-identifier=?,
;; but handle `the-cons' specially ;; but handle `the-cons' specially
(or (free-identifier=? (and (identifier? a)
a (identifier? b)
(if (eq? 'the-cons (syntax-e b)) (or (free-identifier=?
cons-id a
b)) (if (eq? 'the-cons (syntax-e b))
(free-identifier=? cons-id
a b))
(datum->syntax (free-identifier=?
#f a
(if (eq? 'the-cons (syntax-e b)) (datum->syntax
'cons #f
(syntax-e b))))))] (if (eq? 'the-cons (syntax-e b))
'cons
(syntax-e b)))))))]
[remove-all (lambda (lst rmv-lst) [remove-all (lambda (lst rmv-lst)
(define (remove e l) (define (remove e l)
(cond (cond