diff --git a/collects/mzlib/contract.ss b/collects/mzlib/contract.ss
index 54058ca..3e6f307 100644
--- a/collects/mzlib/contract.ss
+++ b/collects/mzlib/contract.ss
@@ -777,11 +777,13 @@ add struct contracts for immutable structs?
                    (with-syntax ([proj-code (build-projs outer-args inner-lambda-w/err-check)])
                      (arguments-check
                       outer-args
-                      (syntax/loc stx
-                        (make-contract
-                         (apply build-compound-type-name 'case-> name-id)
-                         (lambda (pos-blame neg-blame src-info orig-str)
-                           proj-code))))))))))]))
+                      (set-inferred-name-from
+                       stx
+                       (syntax/loc stx
+                         (make-contract
+                          (apply build-compound-type-name 'case-> name-id)
+                          (lambda (pos-blame neg-blame src-info orig-str)
+                            proj-code)))))))))))]))
     
     (define (make-opt->/proc method-proc? stx)
       (syntax-case stx (any)
@@ -840,11 +842,16 @@ add struct contracts for immutable structs?
                               (make-case->/proc
                                method-proc?
                                (syntax (case-> (-> case-doms ... single-case-result) ...)))])
-                 (syntax/loc stx
-                   (let ([res-vs ress] ...
-                         [req-vs reqs] ...
-                         [opt-vs opts] ...)
-                     expanded-case->))))))]))
+                 (set-inferred-name-from
+                  stx
+                  (syntax/loc stx
+                    (let ([res-vs ress] 
+                          ...
+                          [req-vs reqs]
+                          ...
+                          [opt-vs opts]
+                          ...)
+                      expanded-case->)))))))]))
 
     ;; exactract-argument-lists : syntax -> (listof syntax)
     (define (extract-argument-lists stx)
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 00fabb6..2390062 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -2591,9 +2591,31 @@
       (require (lib "contract.ss"))
       (define contract-inferred-name-test-contract (-> integer? any))
       (define (contract-inferred-name-test x) #t)
-      (provide/contract (contract-inferred-name-test contract-inferred-name-test-contract))))
+      (provide/contract (contract-inferred-name-test contract-inferred-name-test-contract))
+      
+      (define (contract-inferred-name-test2 x) x)
+      (provide/contract (contract-inferred-name-test2 (-> number? number?)))
+      
+      (define (contract-inferred-name-test3 x) x)
+      (provide/contract (contract-inferred-name-test3 (->* (number?) (number?))))
+
+      (define (contract-inferred-name-test4 x) x)
+      (provide/contract (contract-inferred-name-test4 (case-> (->* (number?) (number?)))))
+
+      (define contract-inferred-name-test5 (case-lambda [(x) x] [(x y) x]))
+      (provide/contract (contract-inferred-name-test5 (case-> (-> number? number?) 
+                                                              (-> number? number? number?))))
+
+      (define contract-inferred-name-test6 (case-lambda [(x) x]
+                                                        [(x y) y]))
+      (provide/contract (contract-inferred-name-test6 (opt-> (number?) (number?) number?)))))
   (eval '(require contract-test-suite-inferred-name1))
   (eval '(test 'contract-inferred-name-test object-name contract-inferred-name-test))
+  (eval '(test 'contract-inferred-name-test2 object-name contract-inferred-name-test2))
+  (eval '(test 'contract-inferred-name-test3 object-name contract-inferred-name-test3))
+  (eval '(test 'contract-inferred-name-test4 object-name contract-inferred-name-test4))
+  (eval '(test 'contract-inferred-name-test5 object-name contract-inferred-name-test5))
+  (eval '(test 'contract-inferred-name-test6 object-name contract-inferred-name-test6))
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;                                                        ;;