diff --git a/collects/drracket/private/syncheck/contract-traversal.rkt b/collects/drracket/private/syncheck/contract-traversal.rkt
index 8b7c9a370c..79c35fa89d 100644
--- a/collects/drracket/private/syncheck/contract-traversal.rkt
+++ b/collects/drracket/private/syncheck/contract-traversal.rkt
@@ -9,7 +9,6 @@
 (define (annotate-contracts stx low-binders binding-inits)
   (define boundary-start-map (make-hash))
   (define internal-start-map (make-hash))
-  (define arrow-map (make-hash))
   (define domain-map (make-hash))
   (define range-map (make-hash))
   
@@ -23,7 +22,6 @@
     (add-to-map stx 'racket/contract:internal-contract internal-start-map)
     (add-to-map stx 'racket/contract:negative-position domain-map)
     (add-to-map stx 'racket/contract:positive-position range-map)
-    (add-to-map stx 'racket/contract:function-contract arrow-map)
     (syntax-case stx ()
       [(a . b) (loop #'a) (loop #'b)]
       [_ (void)]))
@@ -34,7 +32,7 @@
       (do-contract-traversal start-stx #t
                              my-coloring-plans client-coloring-plans
                              low-binders binding-inits
-                             arrow-map domain-map range-map
+                             domain-map range-map
                              #t)))
   
   ;; fill in the coloring-plans table for internal contracts
@@ -43,7 +41,7 @@
       (do-contract-traversal start-stx #f
                              my-coloring-plans client-coloring-plans
                              low-binders binding-inits
-                             arrow-map domain-map range-map
+                             domain-map range-map
                              #f)))
   
   ;; enact the coloring plans
@@ -63,7 +61,7 @@
 
 (define (do-contract-traversal start-stx boundary-contract?
                                my-coloring-plans client-coloring-plans
-                               low-binders binding-inits arrow-map domain-map range-map polarity)
+                               low-binders binding-inits domain-map range-map polarity)
   (let ploop ([stx start-stx]
               [polarity polarity])
     
@@ -89,11 +87,11 @@
                 (for ((stx (in-list (hash-ref domain-map id '()))))
                   (do-contract-traversal stx boundary-contract?
                                          my-coloring-plans client-coloring-plans
-                                         low-binders binding-inits arrow-map domain-map range-map (not polarity)))
+                                         low-binders binding-inits domain-map range-map (not polarity)))
                 (for ((stx (in-list (hash-ref range-map id '()))))
                   (do-contract-traversal stx boundary-contract?
                                          my-coloring-plans client-coloring-plans
-                                         low-binders binding-inits arrow-map domain-map range-map polarity)))]))]
+                                         low-binders binding-inits domain-map range-map polarity)))]))]
         
         [else
          ;; we didn't find a contract, but we might find one in a subexpression
@@ -159,10 +157,10 @@
             ;; on one side will not pollute the other side.
             (do-contract-traversal #'b boundary-contract?
                                    my-coloring-plans client-coloring-plans
-                                   low-binders binding-inits arrow-map domain-map range-map polarity)
+                                   low-binders binding-inits domain-map range-map polarity)
             (do-contract-traversal #'c boundary-contract?
                                    my-coloring-plans client-coloring-plans
-                                   low-binders binding-inits arrow-map domain-map range-map polarity)]
+                                   low-binders binding-inits domain-map range-map polarity)]
            ;; [(begin expr ...) (void)]
            [(begin0 fst rst ...)
             (ploop #'fst polarity)]
diff --git a/collects/racket/contract/private/arr-i.rkt b/collects/racket/contract/private/arr-i.rkt
index 8d3383a90c..9269407701 100644
--- a/collects/racket/contract/private/arr-i.rkt
+++ b/collects/racket/contract/private/arr-i.rkt
@@ -739,7 +739,15 @@
                               #f)))
                    #,(and (istx-post an-istx) (map syntax-e (pre/post-vars (istx-post an-istx))))))
              'racket/contract:contract 
-             (vector this->i 
-                     ;; the ->i in the original input to this guy
-                     (list (car (syntax-e stx)))
-                     '()))))))
+             (let ()
+               (define (find-kwd kwd)
+                 (for/or ([x (in-list (syntax->list stx))])
+                   (and (eq? (syntax-e x) kwd)
+                        x)))
+               (define pre (find-kwd '#:pre))
+               (define post (find-kwd '#:post))
+               (define orig (list (car (syntax-e stx))))
+               (vector this->i 
+                       ;; the ->i in the original input to this guy
+                       (if post (cons post orig) orig)
+                       (if pre (list pre) '()))))))))
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index a835e356e9..449c100bcd 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -25,6 +25,10 @@
     (parameterize ([current-namespace contract-namespace])
       (compile x)))
   
+  (define (contract-expand-once x)
+    (parameterize ([current-namespace contract-namespace])
+      (expand-once x)))
+  
   (define-syntax (ctest stx)
     (syntax-case stx ()
       [(_ a ...)
@@ -147,15 +151,41 @@
     (contract-eval `(,test ,name contract-name ,contract-exp))
     (contract-eval `(,test ,name contract-name (opt/c ,contract-exp))))
   
-  (test/spec-passed
-   'contract-flat1 
-   '(contract not #f 'pos 'neg))
-  
-  (test/pos-blame
-   'contract-flat2 
-   '(contract not #t 'pos 'neg))
-
  
+  (define (test-obligations quoted-expr expected-props)
+    
+    (define (cleanup key obj stx)
+      (case key 
+        [(racket/contract:contract) 
+         (let ([cleanup-ent
+                (λ (x)
+                  (sort (map syntax->datum (vector-ref obj x)) string<=? #:key (λ (x) (format "~s" x))))])
+         (list key (cleanup-ent 1) (cleanup-ent 2)))]
+        [(racket/contract:positive-position racket/contract:negative-position)
+         (list key (syntax->datum stx))]
+        [(racket/contract:contract-on-boundary) `(racket/contract:contract-on-boundary ,(syntax->datum stx))]
+        [(racket/contract:internal-contract) `(racket/contract:internal-contract ,(syntax->datum stx))]
+        [else
+         (error 'test-obligations "unknown property ~s" key)]))
+    
+    (let ([props '()])
+      (let ([stx (contract-expand-once quoted-expr)])
+        (let loop ([stx stx])
+          (cond
+            [(syntax? stx) 
+             (for ([key (in-list (syntax-property-symbol-keys stx))])
+               (when (regexp-match #rx"^racket/contract:" (symbol->string key))
+                 (set! props (cons (cleanup key (syntax-property stx key) stx)
+                                   props))))
+             (loop (syntax-e stx))]
+            [(pair? stx)
+             (loop (car stx))
+             (loop (cdr stx))])))
+      (test expected-props
+            `(obligations-for ,quoted-expr)
+            (sort props string<=? #:key (λ (x) (format "~s" x))))))
+  
+    
 ;                                                                                                    
 ;                                                                                                    
 ;                                                                                                    
@@ -172,7 +202,6 @@
 ;                                                                                                    
 ;                                                                                                    
 
-  
   (test/no-error '(-> integer? integer?))
   (test/no-error '(-> (flat-contract integer?) (flat-contract integer?)))
   (test/no-error '(-> integer? any))
@@ -3338,7 +3367,16 @@
        1)
       (reverse x))
    '(3 1 2 4))
-
+  
+  (test/spec-passed
+   'contract-flat1 
+   '(contract not #f 'pos 'neg))
+  
+  (test/pos-blame
+   'contract-flat2 
+   '(contract not #t 'pos 'neg))
+  
+  
   
 ;                                                                                              
 ;                                                                                              
@@ -9549,6 +9587,47 @@ so that propagation occurs.
        (λ (x) x)))
    11)
   
+;                                                        
+;                                                        
+;                                                        
+;                                         ;;             
+;                                     ;;  ;;             
+;                                     ;;                 
+;   ;;;;  ;;;; ;;;   ;;;;   ;;;; ;;;;;;;; ;;  ;;;;  ;;;  
+;   ;;;;; ;;;;;;;;;  ;;;;; ;;;;;;;;;;;;;; ;; ;;;;;;;;;;; 
+;   ;; ;; ;;  ;; ;;  ;; ;; ;;; ;;;;   ;;  ;; ;;;;;;;;    
+;   ;; ;; ;;  ;; ;;  ;; ;; ;;;;;;;;   ;;  ;; ;;;;;;  ;;; 
+;   ;;;;; ;;  ;;;;;  ;;;;; ;;;;;;;;   ;;  ;; ;;;;;;;; ;; 
+;   ;;;;  ;;   ;;;   ;;;;   ;;;; ;;   ;;; ;;  ;;;;  ;;;  
+;   ;;               ;;                                  
+;   ;;               ;;                                  
+;                                                        
+
+  
+  (test-obligations '(-> a b)
+                    '((racket/contract:contract (->) ())
+                      (racket/contract:negative-position a)
+                      (racket/contract:positive-position b)))
+  (test-obligations '(->i ([x a]) any)
+                    '((racket/contract:contract (->i) ())
+                      (racket/contract:contract-on-boundary a)
+                      (racket/contract:negative-position a)))
+  (test-obligations '(->i ([x a]) [res b])
+                    '((racket/contract:contract (->i) ())
+                      (racket/contract:contract-on-boundary a)
+                      (racket/contract:contract-on-boundary b)
+                      (racket/contract:negative-position a)
+                      (racket/contract:positive-position b)))
+  (test-obligations '(->i ([x a]) #:pre () #t [res b] #:post () #t)
+                    '((racket/contract:contract (->i #:post) (#:pre))
+                      (racket/contract:contract-on-boundary a)
+                      (racket/contract:contract-on-boundary b)
+                      (racket/contract:negative-position a)
+                      (racket/contract:positive-position b)))
+  (test-obligations '(listof a)
+                    '((racket/contract:contract (listof) ())
+                      (racket/contract:positive-position a)))
+  
   
 ;                                                                
 ;