cleanup names, add tests
This commit is contained in:
parent
6cffbfa6d8
commit
a58fc276c9
|
@ -160,7 +160,7 @@
|
|||
((vectorof/sc (#:invariant)) vectorof #:chaperone)
|
||||
((promise/sc (#:covariant)) promise-not-name/c #:chaperone)
|
||||
((syntax/sc (#:covariant #:flat)) syntax/c #:flat)
|
||||
((hash/sc (#:invariant) (#:invariant)) tr-hash/c #:chaperone)
|
||||
((hash/sc (#:invariant) (#:invariant)) typed-racket-hash/c #:chaperone)
|
||||
((mutable-hash/sc (#:invariant) (#:invariant)) mutable-hash/c #:chaperone)
|
||||
((immutable-hash/sc (#:covariant) (#:covariant)) immutable-hash/c #:flat)
|
||||
((weak-hash/sc (#:invariant) (#:invariant)) weak-hash/c #:chaperone)
|
||||
|
|
|
@ -1,18 +1,28 @@
|
|||
#lang racket/base
|
||||
|
||||
;; Typed Racket custom hashtable contracts.
|
||||
;; Goals:
|
||||
;; - implement contracts for mutable/immutable/weak hashtables
|
||||
;; - give a better error message than `racket/contract` when user
|
||||
;; tries to apply "a contract with a non-flat key"
|
||||
;; to a "hashtable that doesn't compare keys with equal?"
|
||||
|
||||
(require racket/contract)
|
||||
(provide tr-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
|
||||
(provide typed-racket-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
|
||||
|
||||
(define (typed-racket-hash/c k v)
|
||||
(and/c hash? (hash/c/check-key k v)))
|
||||
|
||||
(define (mutable-hash/c k v)
|
||||
(and/c hash? (not/c hash-weak?) (tr-hash/c k v #:immutable #f)))
|
||||
(and/c hash? (not/c hash-weak?) (hash/c/check-key k v #:immutable #f)))
|
||||
|
||||
(define (immutable-hash/c k v)
|
||||
(tr-hash/c k v #:immutable #t))
|
||||
(and/c hash? (hash/c/check-key k v #:immutable #t)))
|
||||
|
||||
(define (weak-hash/c k v)
|
||||
(and/c hash? hash-weak? (tr-hash/c k v #:immutable #f)))
|
||||
(and/c hash? hash-weak? (hash/c/check-key k v #:immutable #f)))
|
||||
|
||||
(define (tr-hash/c k v #:immutable [immutable 'dont-care])
|
||||
(if (flat-contract? k)
|
||||
(hash/c k v #:immutable immutable)
|
||||
(and/c hash? hash-equal? (hash/c k v #:immutable immutable))))
|
||||
(define (hash/c/check-key k v #:immutable [immutable 'dont-care])
|
||||
;; TODO if (flat-contract? k), then make a contract that produces a "good"
|
||||
;; error message given a hashtable that is not a `hash-equal?`
|
||||
(hash/c k v #:immutable immutable))
|
||||
|
|
23
typed-racket-test/succeed/issue-625.rkt
Normal file
23
typed-racket-test/succeed/issue-625.rkt
Normal file
|
@ -0,0 +1,23 @@
|
|||
#lang racket/base
|
||||
|
||||
;; Hash contracts with non-flat keys should give a good error messages
|
||||
;; when applied to hashes that are not `hash-equal?`
|
||||
|
||||
(module t typed/racket/base
|
||||
(provide give-me-a-hash)
|
||||
(: give-me-a-hash (-> (HashTable (Vectorof Symbol) Symbol) Symbol))
|
||||
(define (give-me-a-hash x)
|
||||
'thanks))
|
||||
|
||||
(require 't rackunit)
|
||||
|
||||
(define err-regexp #rx"expected equal\\?-based hash")
|
||||
|
||||
(check-exn err-regexp
|
||||
(λ () (give-me-a-hash (hasheqv))))
|
||||
|
||||
(check-exn err-regexp
|
||||
(λ () (give-me-a-hash (hasheq))))
|
||||
|
||||
(check-not-exn
|
||||
(λ () (give-me-a-hash (hash))))
|
|
@ -70,6 +70,12 @@
|
|||
(t/sc (-mu sexp (Un -Null -Symbol (-pair sexp sexp) (-vec sexp) (-box sexp))))
|
||||
(t/sc (-mu a (-> a a)))
|
||||
(t/sc (-seq -Symbol))
|
||||
;; HashTables with non-flat keys and values (Issue 625)
|
||||
;; https://github.com/racket/typed-racket/issues/625
|
||||
(t/sc (-Mutable-HT (-vec -Symbol) (-vec -Symbol)))
|
||||
(t/sc (-Immutable-HT (-vec -Symbol) (-vec -Symbol)))
|
||||
(t/sc (-Weak-HT (-vec -Symbol) (-vec -Symbol)))
|
||||
(t/sc (-HT (-vec -Symbol) (-vec -Symbol)))
|
||||
;; These tests for unit static contracts are insufficient, but
|
||||
;; in order to test Unit types the signature environment must be
|
||||
;; set up correctly. More complex cases of compilation to unit/c
|
||||
|
|
Loading…
Reference in New Issue
Block a user