diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt index 714197ddec..8c6f204bb4 100644 --- a/pkgs/racket-test/tests/racket/contract/prof.rkt +++ b/pkgs/racket-test/tests/racket/contract/prof.rkt @@ -521,4 +521,39 @@ (eval '(async-channel-put c 3)) (eval '(async-channel-get c)))) + (test/spec-passed + 'contract-marks57 + '(let () + (eval '(require racket/generic)) + (eval '(define-generics fooable (foo fooable))) + (eval '(struct s () #:methods gen:fooable [(define (foo x) x)])) + (eval '(foo (contract (generic-instance/c gen:fooable [foo (-> pos-blame? neg-blame?)]) + (s) 'pos 'neg))))) + + (test/spec-passed + 'contract-marks58 + '(let () + (eval '(require racket/set)) + (eval '(define s (contract (set/c pos-blame?) (set 1 2 3) 'pos 'neg))) + (eval '(set-add s 3)) + (eval '(set-member? s 3)))) + + (test/spec-passed + 'contract-marks59 + '(let () + (eval '(require racket/set)) + (eval '(define s (contract (set/c pos-blame? #:lazy? #t #:kind 'mutable) + (mutable-set 1 2 3) 'pos 'neg))) + (eval '(set-add! s 3)) + (eval '(set-member? s 3)))) + + (test/spec-passed + 'contract-marks60 + '(let () + (eval '(require racket/set)) + (eval '(define s (contract (set/c pos-blame? #:kind 'dont-care) + (list 1 2 3) 'pos 'neg))) + (eval '(set-add s 3)) + (eval '(set-member? s 3)))) + ) diff --git a/racket/collects/racket/set.rkt b/racket/collects/racket/set.rkt index 8df5a90110..9c0fd16673 100644 --- a/racket/collects/racket/set.rkt +++ b/racket/collects/racket/set.rkt @@ -198,6 +198,7 @@ (λ (val neg-party) (set-contract-check cmp kind blame neg-party val) (define (pos-interpose val ele) (late-neg-pos-proj ele neg-party)) + (define blame+neg-party (cons blame neg-party)) (cond [(set? val) (chaperone-hash-set @@ -205,31 +206,44 @@ (λ (val ele) ele) (λ (val ele) ele) (λ (val ele) ele) - (λ (val ele) (late-neg-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-pos-proj ele neg-party))) (λ (val) (void)) - (λ (val ele) (late-neg-equal-key-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-equal-key-pos-proj ele neg-party))) impersonator-prop:contracted ctc impersonator-prop:blame (cons blame neg-party))] [else (chaperone-hash-set val (λ (val ele) ele) - (λ (val ele) (late-neg-neg-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-neg-proj ele neg-party))) (λ (val ele) ele) - (λ (val ele) (late-neg-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-pos-proj ele neg-party))) (λ (val) (void)) - (λ (val ele) (late-neg-equal-key-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-equal-key-pos-proj ele neg-party))) impersonator-prop:contracted ctc impersonator-prop:blame (cons blame neg-party))]))] [else (λ (val neg-party) + (define blame+neg-party (cons blame neg-party)) (set-contract-check cmp kind blame neg-party val) (cond [(set? val) (chaperone-hash-set (for/fold ([s (set-clear val)]) ([e (in-set val)]) - (set-add s (late-neg-pos-proj e neg-party))) + (set-add s (with-contract-continuation-mark + blame+neg-party + (late-neg-pos-proj e neg-party)))) #f #f #f impersonator-prop:contracted ctc impersonator-prop:blame (cons blame neg-party))] @@ -240,11 +254,17 @@ (chaperone-hash-set val (λ (val ele) ele) - (λ (val ele) (late-neg-neg-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-neg-proj ele neg-party))) (λ (val ele) ele) - (λ (val ele) (late-neg-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-pos-proj ele neg-party))) (λ (val) (void)) - (λ (val ele) (late-neg-equal-key-pos-proj ele neg-party)) + (λ (val ele) (with-contract-continuation-mark + blame+neg-party + (late-neg-equal-key-pos-proj ele neg-party))) impersonator-prop:contracted ctc impersonator-prop:blame (cons blame neg-party))]))])))