suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid absolute CPU time requirement in test

Browse Source 
Relevant to #2964
This commit is contained in:
Matthew Flatt 2019-12-14 10:05:32 -07:00
parent 6380df8aca
commit c8877055da
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-test/tests/racket/contract/recursive-contract.rkt
View File

@ -125,18 +125,22 @@
(test/spec-passed/result (test/spec-passed/result
'recursive-contract-not-too-slow 'recursive-contract-not-too-slow
'(let () '(let ()
(define c (define (time-it n)
(recursive-contract (define c
(or/c null? (recursive-contract
(cons/c (-> integer? integer? integer?) c) (or/c null?
(cons/c (-> integer? integer?) (cons/c (-> integer? integer?) c))))) (cons/c (-> integer? integer? integer?) c)
(cons/c (-> integer? integer?) (cons/c (-> integer? integer?) c)))))
(define l (build-list 10000 (λ (x) (λ (x) x)))) (collect-garbage)
(define-values (_ cpu real gc) (define l (build-list n (λ (x) (λ (x) x))))
(time-apply (λ () (contract c l 'pos 'neg)) '())) (define-values (_ cpu real gc)
;; should be substantially less than 5 seconds. (time-apply (λ () (contract c l 'pos 'neg)) '()))
;; with the old implementation it is more like 20 seconds cpu)
;; on my laptop and about .3 seconds with the new one ;; Doubling the list length should not increase the
(< (- cpu gc) 5000)) ;; run time by more than a factor of three; try up
;; to three times, just in case
(for/or ([i (in-range 3)])
(> (* 3 (time-it 4000))
(time-it 8000))))
#t #t
do-not-double-wrap)) do-not-double-wrap))