From 72418fba03bd06c1f22d30f016493e051df2249a Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 8 Jan 2016 14:58:03 -0600
Subject: [PATCH] Instrument higher-order hash/c.

---
 .../tests/racket/contract/prof.rkt            | 10 ++++++++
 .../collects/racket/contract/private/hash.rkt | 23 ++++++++++++++-----
 2 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt
index 270bf2e99d..dc5a5feab5 100644
--- a/pkgs/racket-test/tests/racket/contract/prof.rkt
+++ b/pkgs/racket-test/tests/racket/contract/prof.rkt
@@ -276,4 +276,14 @@
       (eval '(f 2)))
    3)
 
+  (test/spec-passed/result
+   'contract-marks31
+   '((hash-ref (contract (hash/c (-> neg-blame? pos-blame?)
+                                 (-> neg-blame? pos-blame?))
+                         (hash values values)
+                         'pos 'neg)
+               values)
+     3)
+   3)
+
   )
diff --git a/racket/collects/racket/contract/private/hash.rkt b/racket/collects/racket/contract/private/hash.rkt
index 712d735975..cb3882580a 100644
--- a/racket/collects/racket/contract/private/hash.rkt
+++ b/racket/collects/racket/contract/private/hash.rkt
@@ -234,6 +234,7 @@
 (define (handle-the-hash val neg-party
                          pos-dom-proj neg-dom-proj mk-pos-rng-proj mk-neg-rng-proj
                          chaperone-or-impersonate-hash ctc blame)
+  (define blame+neg-party (cons blame neg-party))
   (if (immutable? val) 
       (for/fold ([h val]) ([(k v) (in-hash val)])
         (hash-set h
@@ -242,16 +243,26 @@
       (chaperone-or-impersonate-hash
        val
        (λ (h k)
-         (values (neg-dom-proj k neg-party)
+         (values (with-contract-continuation-mark
+                  blame+neg-party
+                  (neg-dom-proj k neg-party))
                  (λ (h k v)
-                   ((mk-pos-rng-proj k) v neg-party))))
+                   (with-contract-continuation-mark
+                    blame+neg-party
+                    ((mk-pos-rng-proj k) v neg-party)))))
        (λ (h k v)
-         (values (neg-dom-proj k neg-party)
-                 ((mk-neg-rng-proj k) v neg-party)))
+         (with-contract-continuation-mark
+          blame+neg-party
+          (values (neg-dom-proj k neg-party)
+                  ((mk-neg-rng-proj k) v neg-party))))
        (λ (h k)
-         (neg-dom-proj k neg-party))
+         (with-contract-continuation-mark
+          blame+neg-party
+          (neg-dom-proj k neg-party)))
        (λ (h k)
-         (pos-dom-proj k neg-party))
+         (with-contract-continuation-mark
+          blame+neg-party
+          (pos-dom-proj k neg-party)))
        impersonator-prop:contracted ctc
        impersonator-prop:blame blame)))