Fix #%app bindings for `with-contract'-based contract forms.

Closes PR11975.
This commit is contained in:
Stevie Strickland 2011-06-16 14:23:10 -04:00
parent e35e005a1c
commit 649fe2f276
2 changed files with 22 additions and 3 deletions

View File

@ -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

View File

@ -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))
;
;