From 649fe2f2769fac1fc91b43a78e1e07cde34f589b Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Thu, 16 Jun 2011 14:23:10 -0400
Subject: [PATCH] Fix #%app bindings for `with-contract'-based contract forms.

Closes PR11975.
---
 collects/racket/contract/region.rkt      |  8 +++++---
 collects/tests/racket/contract-test.rktl | 17 +++++++++++++++++
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/collects/racket/contract/region.rkt b/collects/racket/contract/region.rkt
index 4411660d33..95a059b595 100644
--- a/collects/racket/contract/region.rkt
+++ b/collects/racket/contract/region.rkt
@@ -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
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 1b94b56f66..d36a6e323b 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -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))
 
 ;                                                                                                                         
 ;