more tests

Author: Andrew Kent

typed-racket-test/succeed/rest-star-hash-examples.rkt

@@ -1,5 +1,7 @@
 #lang typed/racket/base
 
+(provide my-hash my-hash-set*)
+
 (require racket/match)
 
 (define-type (KV-List K V) (Rec T (U Null (List* K V T))))
@@ -13,6 +15,16 @@
        (loop (hash-set h k v) rst)]   
       [_ h])))
 
+(: my-mutable-hash (All (K V) (->* () #:rest-star (K V) (Mutable-HashTable K V))))
+(define (my-mutable-hash . k/v-list)
+  (define h : (Mutable-HashTable K V) (make-hash))
+  (let loop! ([to-add : (KV-List K V) k/v-list])
+    (match to-add
+      [(cons k (cons v rst))
+       (hash-set! h k v)
+       (loop! rst)]
+      [_ h])))
+
 
 (: my-hash-set* (All (K V) (->* ((Immutable-HashTable K V)) #:rest-star (K V) (Immutable-HashTable K V))))
 (define (my-hash-set* orig . k/v-list)
@@ -23,6 +35,18 @@
        (loop (hash-set h k v) rst)]
       [_ h])))
 
+(: my-hash-set*! (All (K V) (->* ((Mutable-HashTable K V)) #:rest-star (K V) Void)))
+(define (my-hash-set*! orig . k/v-list)
+  (let loop! ([to-add : (KV-List K V) k/v-list])
+    (match to-add
+      [(cons k (cons v rst))
+       (hash-set! h k v)
+       (loop! rst)]
+      [_ (void)])))
+
 
 (define h (my-hash "Hello" 'world "How" 'are "you" 'today?))
-(my-hash-set* h "one" 'more)
+(my-hash-set* h "one" 'more)
+
+(define mh (my-mutable-hash "Hello" 'world "How" 'are "you" 'today?))
+(my-hash-set*! mh "one" 'more)

typed-racket-test/unit-tests/contract-tests.rkt

@@ -724,5 +724,83 @@
                (λ (x y) #f)
                #:untyped
                #:msg #rx"promised:.*#t.*produced:.*#f")
-   
+
+   ;; #:rest-star args
+   (t (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean))
+   (t (->* (list -Zero) (make-Rest (list -Zero -Zero)) -Zero))
+   (t (->* (list) (make-Rest (list -Boolean -String -Boolean -String -Boolean -String)) -Zero))
+   (t (->optkey [-Zero] #:rest Univ -Boolean))
+   (t-int (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:untyped)
+   (t-int (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:typed)
+   (t-int (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 0 'zero))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:untyped)
+   (t-int (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 0 'zero 0 'zero))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:untyped)
+   (t-int (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 0 'zero 0 'zero))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:typed)
+   ;; shouldn't error since we should trust the typed side, right?
+   ;(t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+   ;       (λ (c) (c 'zero 'zero))
+   ;       (case-lambda
+   ;         [(zero) #t]
+   ;         [(zero . rst) #f])
+   ;       #:untyped
+   ;       #:msg #rx"given: '(zero)")
+   (t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+               (λ (c) (c 0))
+               (case-lambda
+                 [(zero) 'true]
+                 [(zero . rst) 'false])
+               #:untyped
+               #:msg #rx"produced: 'true")
+   (t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+               (λ (c) (c 0))
+               (case-lambda
+                 [(zero) 'true]
+                 [(zero . rst) 'false])
+               #:untyped
+               #:msg #rx"produced: 'true")
+   (t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 'zero))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:typed
+          #:msg #rx"contract violation")
+   (t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 0 0))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:typed
+          #:msg #rx"contract violation")
+   (t-int/fail (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
+          (λ (c) (c 0 0 'zero 0))
+          (case-lambda
+            [(zero) #t]
+            [(zero . rst) #f])
+          #:typed
+          #:msg #rx"contract violation")
    ))

typed-racket-test/unit-tests/subtype-tests.rkt

@@ -387,6 +387,8 @@
    ;; #:rest-star
    [(->* (list -Zero) Univ -Boolean)
     (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)]
+   [(->optkey [-Zero] #:rest Univ -Boolean)
+    (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)]
    [FAIL
     (->* (list -Zero) (make-Rest (list -Zero -Symbol)) -Boolean)
     (->* (list -Zero) Univ -Boolean)]