diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/set.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/set.rktl index d92c40f323..af6f3c5fa7 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/set.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/set.rktl @@ -561,6 +561,7 @@ (add1 i))) ;; ---------------------------------------- +;; set/c tests (err/rt-test (set/c '(not a contract))) (err/rt-test (set/c any/c #:cmp 'not-a-comparison)) @@ -568,4 +569,32 @@ (err/rt-test (set/c (-> integer? string?) #:cmp 'eq)) (err/rt-test (set/c (-> integer? string?) #:cmp 'eqv)) +(define (app-ctc ctc value) + (contract ctc value 'positive 'negative)) + +(define (positive-error? exn) + (and exn:fail:contract? + (regexp-match? "blaming: positive" (exn-message exn)))) +(define (negative-error? exn) + (and exn:fail:contract? + (regexp-match? "blaming: negative" (exn-message exn)))) + +(define-syntax-rule (test/blame-pos e) + (thunk-error-test (lambda () e) #'e positive-error?)) +(define-syntax-rule (test/blame-neg e) + (thunk-error-test (lambda () e) #'e negative-error?)) + +;; check dont-care defaults +(test #t set? (app-ctc (set/c any/c) (set))) +(test #t set-mutable? (app-ctc (set/c any/c) (mutable-set))) +(test #t set? (app-ctc (set/c any/c) (seteq))) +(test #t set-mutable? (app-ctc (set/c any/c) (mutable-seteqv))) + +(test/blame-pos (app-ctc (set/c any/c #:cmp 'eq) (set))) +(test/blame-pos (app-ctc (set/c any/c #:kind 'mutable) (set))) +(test/blame-pos (app-ctc (set/c string? #:kind 'immutable) (set 1))) +(test #t set? (app-ctc (set/c string?) (set 1))) ; ok bc we get a ho contract +(test/blame-pos (set-first (app-ctc (set/c string?) (set 1)))) +(test/blame-neg (set-add! (app-ctc (set/c string?) (mutable-set)) 1)) + (report-errs) diff --git a/racket/collects/racket/set.rkt b/racket/collects/racket/set.rkt index 7f385a1198..fb4744e2fe 100644 --- a/racket/collects/racket/set.rkt +++ b/racket/collects/racket/set.rkt @@ -12,7 +12,7 @@ (define (set/c elem/c #:cmp [cmp 'dont-care] - #:kind [kind 'immutable]) + #:kind [kind 'dont-care]) (define cmp/c (case cmp [(dont-care) any/c]