Fix #%app bindings for `with-contract'-based contract forms.
Closes PR11975.
This commit is contained in:
parent
e35e005a1c
commit
649fe2f276
|
@ -467,9 +467,11 @@
|
|||
(quasisyntax/loc stx
|
||||
(set! id (contract ctc arg neg pos (quote id) (quote-srcloc id))))]
|
||||
[(f arg ...)
|
||||
(quasisyntax/loc stx
|
||||
((contract ctc id pos neg (quote id) (quote-srcloc id))
|
||||
arg ...))]
|
||||
(with-syntax ([app (datum->syntax stx '#%app)])
|
||||
(quasisyntax/loc stx
|
||||
(app
|
||||
(contract ctc id pos neg (quote id) (quote-srcloc id))
|
||||
arg ...)))]
|
||||
[ident
|
||||
(identifier? (syntax ident))
|
||||
(quasisyntax/loc stx
|
||||
|
|
|
@ -4864,6 +4864,23 @@
|
|||
(define (f) (values 3 "foo"))
|
||||
(f))])
|
||||
1))
|
||||
|
||||
(test/spec-passed/result
|
||||
'with-contract-#%app
|
||||
'(begin
|
||||
(eval '(module app racket
|
||||
(define-syntax (-app x) #''apped)
|
||||
(provide (rename-out (-app #%app)))))
|
||||
(eval '(module b racket
|
||||
(require 'app)
|
||||
(provide h i)
|
||||
(with-contract x ([f any/c]) (define (f x) 'f))
|
||||
(define (g x) 'g)
|
||||
(define h (f 2))
|
||||
(define i (g 2))))
|
||||
(eval '(require 'b))
|
||||
(eval '(list h i)))
|
||||
(list 'apped 'apped))
|
||||
|
||||
;
|
||||
;
|
||||
|
|
Loading…
Reference in New Issue
Block a user