Adding stress testing library

collects/tests/stress/racket/dict.rkt

@@ -0,0 +1,114 @@
+#lang racket
+(require tests/stress/stress)
+
+(define (make-random-hash-table n)
+  (for/hasheq ([i (in-range n)])
+    (values i (random n))))
+
+; dict-keys, dict-values, dict->list
+(local [(define ht (make-random-hash-table 100000))]
+  (stress 20
+   ["for/list, in-dict-keys"
+    (for/list ([k (in-dict-keys ht)])
+      k)]
+   ["dict-keys"
+    (dict-keys ht)])
+  
+  (stress 20
+   ["for/list, in-dict-values"
+    (for/list ([v (in-dict-values ht)])
+      v)]
+   ["dict-values"
+    (dict-values ht)])
+  
+  (stress 20
+   ["for/list, in-dict"
+    (for/list ([(k v) (in-dict ht)])
+      (cons k v))]
+   ["for/list, in-dict-pairs"
+    (for/list ([p (in-dict-pairs ht)])
+      p)]
+   ["dict->list"
+    (dict->list ht)]))
+
+; dict-set*
+(local [(define ht (hasheq))
+        (define-syntax (inlined-dict-set* stx)
+          (syntax-case stx ()
+            [(_ ht 0) #'ht]
+            [(_ ht n) #`(dict-set (inlined-dict-set* ht #,(sub1 (syntax->datum #'n))) n #f)]))
+        (define-syntax (fun-dict-set* stx)
+          (syntax-case stx ()
+            [(_ ht n)
+             #`(dict-set* ht #,@(apply append
+                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                         (list i #f))))]))]
+  (stress
+   20
+   ["inlined, dict-set*"
+    (inlined-dict-set* ht 4000)]
+   ["for/fold, dict-set*"
+    (for/fold ([ht ht])
+      ([i (in-range 4000)])
+      (dict-set ht i #f))]
+   ["dict-set*"
+    (fun-dict-set* ht 4000)]))
+
+; dict-set*!
+(local [(define ht (make-hasheq))
+        (define-syntax (inlined-dict-set*! stx)
+          (syntax-case stx ()
+            [(_ ht 0) #'(void)]
+            [(_ ht n) #`(begin (inlined-dict-set*! ht #,(sub1 (syntax->datum #'n))) (dict-set! ht n #f))]))
+        (define-syntax (fun-dict-set*! stx)
+          (syntax-case stx ()
+            [(_ ht n)
+             #`(dict-set*! ht #,@(apply append
+                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                         (list i #f))))]))]
+  (stress
+   20
+   ["inlined dict-set*!"
+    (inlined-dict-set*! ht 4000)]
+   ["for, dict-set*!"
+    (for ([i (in-range 4000)])
+      (dict-set! ht i #f))]
+   ["dict-set*!"
+    (fun-dict-set*! ht 4000)]))
+ 
+; dict-ref!
+(local [(define ht (make-hasheq (list (cons 1 #f))))]
+  (stress 
+   200
+   ["hash-ref! (present)"
+    (hash-ref! ht 1 #t)]
+   ["dict-ref! (present)"
+    (dict-ref! ht 1 #t)]))
+
+; XXX dict-ref! is clearly slower
+(local []
+  (stress 
+   200
+   ["hash-ref! (not present)"
+    (hash-ref! (make-hasheq (list (cons 1 #f))) 2 #t)]
+   ["dict-ref! (not present)"
+    (dict-ref! (make-hasheq (list (cons 1 #f))) 2 #t)]))
+
+; dict-has-key?
+; XXX dict functions are slower
+(local [(define ht (make-hasheq (list (cons 1 #f))))]
+  (stress 
+   200
+   ["hash-has-key? (present)"
+    (hash-has-key? ht 1)]
+   ["dict-has-key? (present)"
+    (dict-has-key? ht 1)]))
+
+(local [(define ht (make-hasheq (list (cons 1 #f))))]
+  (stress 
+   200
+   ["hash-has-key? (not present)"
+    (hash-has-key? ht 2)]
+   ["dict-has-key? (not present)"
+    (dict-has-key? ht 2)]))
+

collects/tests/stress/racket/hash.rkt

@@ -0,0 +1,76 @@
+#lang racket
+(require tests/stress/stress)
+
+(define (make-random-hash-table n)
+  (for/hasheq ([i (in-range n)])
+    (values i (random n))))
+
+; hash-keys, hash-values, hash->list
+(local [(define ht (make-random-hash-table 100000))]
+  (stress 20
+   ["for/list, in-hash-keys"
+    (for/list ([k (in-hash-keys ht)])
+      k)]
+   ["hash-keys"
+    (hash-keys ht)])
+  
+  (stress 20
+   ["for/list, in-hash-values"
+    (for/list ([v (in-hash-values ht)])
+      v)]
+   ["hash-values"
+    (hash-values ht)])
+  
+  (stress 20
+   ["for/list, in-hash"
+    (for/list ([(k v) (in-hash ht)])
+      (cons k v))]
+   ["hash->list"
+    (hash->list ht)]))
+
+; hash-set*
+(local [(define ht (hasheq))
+        (define-syntax (inlined-hash-set* stx)
+          (syntax-case stx ()
+            [(_ ht 0) #'ht]
+            [(_ ht n) #`(hash-set (inlined-hash-set* ht #,(sub1 (syntax->datum #'n))) n #f)]))
+        (define-syntax (fun-hash-set* stx)
+          (syntax-case stx ()
+            [(_ ht n)
+             #`(hash-set* ht #,@(apply append
+                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                         (list i #f))))]))]
+  (stress
+   20
+   ["inlined, hash-set*"
+    (inlined-hash-set* ht 4000)]
+   ["for/fold, hash-set*"
+    (for/fold ([ht ht])
+      ([i (in-range 4000)])
+      (hash-set ht i #f))]
+   ["hash-set*"
+    (fun-hash-set* ht 4000)]))
+
+; hash-set*!
+(local [(define ht (make-hasheq))
+        (define-syntax (inlined-hash-set*! stx)
+          (syntax-case stx ()
+            [(_ ht 0) #'(void)]
+            [(_ ht n) #`(begin (inlined-hash-set*! ht #,(sub1 (syntax->datum #'n))) (hash-set! ht n #f))]))
+        (define-syntax (fun-hash-set*! stx)
+          (syntax-case stx ()
+            [(_ ht n)
+             #`(hash-set*! ht #,@(apply append
+                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                         (list i #f))))]))]
+  (stress
+   20
+   ["inlined hash-set*!"
+    (inlined-hash-set*! ht 4000)]
+   ["for, hash-set*!"
+    (for ([i (in-range 4000)])
+      (hash-set! ht i #f))]
+   ["hash-set*!"
+    (fun-hash-set*! ht 4000)]))
+ 
+

collects/tests/stress/racket/sequence.rkt

@@ -0,0 +1,113 @@
+#lang racket
+(require tests/stress/stress)
+
+; seqn-first
+; This ignores the greater flexiblity of seqn-first to have more than single-valued sequences
+(stress
+ 200
+ ["seqn-first"
+  (seqn-first (in-naturals))]
+ ["for/or (val)"
+  (define s (in-naturals))
+  (for/or ([n s])
+    n)]
+ ["for/or"
+  (for/or ([n (in-naturals)])
+    n)])
+
+; seqn-length
+; The for/fold must be rewritten slightly differently for multi-valued
+(stress
+ 20
+ ["seqn-length"
+  (seqn-length (in-range 2000))]
+ ["for/fold (val)"
+  (define s (in-range 2000))
+  (for/fold ([len 0])
+    ([i s])
+    (add1 len))]
+ ["for/fold"
+  (for/fold ([len 0])
+    ([i (in-range 2000)])
+    (add1 len))])
+
+; seqn-ref
+; Ditto
+(stress
+ 20
+ ["seqn-ref"
+  (seqn-ref (in-range 2000) 200)]
+ ["for/or val"
+  (define s (in-range 2000))
+  (for/or ([e s]
+           [i (in-naturals)]
+           #:when (i . = . 199))
+    e)]
+ ["for/or"
+  (for/or ([e (in-range 2000)]
+           [i (in-naturals)]
+           #:when (i . = . 199))
+    e)])
+
+; seqn-andmap
+; ditto
+(stress
+ 20
+ ["seqn-andmap"
+  (seqn-andmap number? (in-range 2000))]
+ ["for/and val"
+  (define s (in-range 2000))
+  (for/and ([e s])
+    (number? e))]
+ ["for/and"
+  (for/and ([e (in-range 2000)])
+    (number? e))])
+
+; seqn-ormap
+; ditto
+(stress
+ 20
+ ["seqn-ormap"
+  (seqn-ormap string? (in-range 2000))]
+ ["for/and val"
+  (define s (in-range 2000))
+  (for/or ([e s])
+    (string? e))]
+ ["for/and"
+  (for/or ([e (in-range 2000)])
+    (string? e))])
+
+; seqn-fold
+; The for/fold must be rewritten slightly differently for multi-valued
+(stress
+ 20
+ ["seqn-fold"
+  (seqn-fold + 0 (in-range 2000))]
+ ["for/fold (val)"
+  (define s (in-range 2000))
+  (for/fold ([sum 0])
+    ([i s])
+    (+ i sum))]
+ ["for/fold"
+  (for/fold ([sum 0])
+    ([i (in-range 2000)])
+    (+ i sum))])
+
+; seqn-count
+; The for/fold must be rewritten slightly differently for multi-valued
+(stress
+ 20
+ ["seqn-count"
+  (seqn-count even? (in-range 2000))]
+ ["for/fold (val)"
+  (define s (in-range 2000))
+  (for/fold ([num 0])
+    ([i s]
+     #:when (even? i))
+    (add1 num))]
+ ["for/fold"
+  (for/fold ([num 0])
+    ([i (in-range 2000)]
+     #:when (even? i))
+    (add1 num))])
+

collects/tests/stress/racket/vector.rkt

@@ -0,0 +1,32 @@
+#lang racket
+(require tests/stress/stress
+         racket/unsafe/ops)
+
+; vector-set*!
+(local [(define vec (make-vector 8001 #t))
+        (define-syntax (inlined-vector-set*! stx)
+          (syntax-case stx ()
+            [(_ vec 0) #'(void)]
+            [(_ vec n) #`(begin (inlined-vector-set*! vec #,(sub1 (syntax->datum #'n))) (vector-set! vec n #f))]))
+        (define-syntax (fun-vector-set*! stx)
+          (syntax-case stx ()
+            [(_ vec n)
+             #`(vector-set*! vec #,@(apply append
+                                       (for/list ([i (in-range (syntax->datum #'n))])
+                                         (list i #f))))]))]
+  (stress
+   20
+   ; XXX if there was an unsafe-vector-set!/bounds, we could test vector? once
+   ["inlined vector-set*!"
+    (inlined-vector-set*! vec 8000)]
+   ["for, vector-set!"
+    (for ([i (in-range 8000)])
+      (vector-set! vec i #f))]
+   ["for, unsafe-vector-set!"
+    (for ([i (in-range 8000)])
+      (unsafe-vector-set! vec i #f))]
+   ["for, unsafe-vector*-set!"
+    (for ([i (in-range 8000)])
+      (unsafe-vector*-set! vec i #f))]
+   ["vector-set*!"
+    (fun-vector-set*! vec 8000)]))

collects/tests/stress/stress.rkt

@@ -0,0 +1,46 @@
+#lang racket
+(provide stress)
+
+(define-syntax-rule (stress trials-expr [label body ...] ...)
+  (stress* trials-expr
+           (cons label (λ () body ...))
+           ...))
+
+(define (cumulative-average ca x i)
+  (+ ca (/ (- x ca) (add1 i))))
+
+(define (run-experiment how-many exp)
+  (match-define (cons label thunk) exp)
+  (define-values
+    (cpu real gc)
+    (for/fold ([cpu0 0.0]
+               [real0 0.0]
+               [gc0 0.0])
+      ([trial-n (in-range how-many)])
+      (define exp-cust (make-custodian))
+      (define-values (_ cpu1 real1 gc1) 
+        (parameterize ([current-custodian exp-cust])
+          (time-apply thunk empty)))
+      (custodian-shutdown-all exp-cust)
+      (when (zero? (modulo trial-n 5))
+        (collect-garbage) (collect-garbage))
+      (values (cumulative-average cpu0 cpu1 trial-n)
+              (cumulative-average real0 real1 trial-n)
+              (cumulative-average gc0 gc1 trial-n))))
+  (vector label cpu real gc))
+
+(define (stress* how-many . experiments)
+  (stress-display
+   how-many
+   (sort 
+    (for/list ([exp (in-list experiments)])
+      (run-experiment how-many exp))
+    <=
+    #:key (λ (v) (vector-ref v 1)))))
+
+(define (stress-display how-many res)
+  (for ([v (in-list res)])
+    (match-define (vector label cpu real gc) v)
+    (printf "~a: cpu time: ~a real time: ~a gc time: ~a (averaged over ~a runs)\n"
+            label cpu real gc how-many))
+  (newline))