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

cs: fix hashing on vector cycles

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-16 20:50:41 -07:00
parent b5cce5fcab
commit 11f12d69bd
2 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-test-core/tests/racket/testing.rktl
View File

@ -356,15 +356,21 @@ transcript.
(define non-z void)
(define (find-depth go)
; Find depth that triggers a stack overflow (assuming no other
; threads are running and overflowing)
(let ([v0 (make-vector 6)]
[v1 (make-vector 6)])
(let find-loop ([d 100])
(vector-set-performance-stats! v0)
(go d)
(vector-set-performance-stats! v1)
(if (> (vector-ref v1 5)
(vector-ref v0 5))
d
(find-loop (* 2 d))))))
(cond
[(eq? 'racket (system-type 'vm))
; Find depth that triggers a stack overflow (assuming no other
; threads are running and overflowing)
(let ([v0 (make-vector 6)]
[v1 (make-vector 6)])
(let find-loop ([d 100])
(vector-set-performance-stats! v0)
(go d)
(vector-set-performance-stats! v1)
(if (> (vector-ref v1 5)
(vector-ref v0 5))
d
(find-loop (* 2 d)))))]
[else
;; No way to detect stack overflow, and it's less interesting anyway,
;; but make up a number for testing purposes
1000]))

2
racket/src/cs/rumble/hash-code.ss
View File

@ -122,7 +122,7 @@
(cond
[(fx= i len) (values hc burn)]
[else
(let-values ([(hc0 burn) (equal-hash-loop (vector-ref x i) burn 0)])
(let-values ([(hc0 burn) (equal-hash-loop (vector-ref x i) (fx+ burn 2) 0)])
(vec-loop (fx+ i 1)
burn
(+/fx (mix2 hc) hc0)))]))]))]