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

cs: guard internal hash traversals against GCed keys

Browse Source 
Hash iteration can fail if a GC collects a key in between
`hash-iterate-next` and `hash-iterate-key` (and similar). Use the
optional extra argument internally to detect and handle that case.
This commit is contained in:
Matthew Flatt 2019-12-25 17:53:01 -06:00
parent 9db9991df6
commit 90abbb912d
2 changed files with 72 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
pkgs/racket-test-core/tests/racket/hash.rktl
View File

@ -527,6 +527,44 @@
(test-hash-ref-key/immut (hasheqv) eq? 'foo 'foo))
;; ----------------------------------------
;;
;; Run a GC concurrent to `hash-for-each` or `hash-map`
;; to make sure a disappearing key doesn't break the
;; iteration
(define (check-concurrent-gc-of-keys hash-iterate)
(define gc-thread
(thread
(lambda ()
(let loop ([n 10])
(unless (zero? n)
(collect-garbage)
(sleep)
(loop (sub1 n)))))))
(let loop ()
(unless (thread-dead? gc-thread)
(let ([ls (for/list ([i 100])
(gensym))])
(define ht (make-weak-hasheq))
(for ([e (in-list ls)])
(hash-set! ht e 0))
;; `ls` is unreferenced here here on
(define counter 0)
(hash-iterate
ht
(lambda (k v)
(set! counter (add1 counter))
'ok))
'(printf "~s @ ~a\n" counter j))
(loop))))
(check-concurrent-gc-of-keys hash-for-each)
(check-concurrent-gc-of-keys hash-map)
(check-concurrent-gc-of-keys (lambda (ht proc)
(equal? ht (hash-copy ht))))
(check-concurrent-gc-of-keys (lambda (ht proc)
(equal-hash-code ht)))
;; ----------------------------------------
(report-errs)

56
racket/src/cs/rumble/hash.ss
View File

@ -158,9 +158,11 @@
(unless (impersonate-hash-clear ht #t)
;; fall back to iterated remove
(let loop ([i (hash-iterate-first ht)])
(when i
(hash-remove! ht (hash-iterate-key ht i))
(loop (hash-iterate-next ht i)))))]
(when i
(let ([k (hash-iterate-key ht i none2)])
(unless (eq? k none2)
(hash-remove! ht k)))
(loop (hash-iterate-next ht i)))))]
[else (raise-argument-error 'hash-clear! "(and/c hash? (not/c immutable?))" ht)]))
(define (mutable-hash-clear! ht)
@ -400,8 +402,9 @@
;; mutable, impersonated, and weak-equal:
(let loop ([i (hash-iterate-first ht)])
(when i
(let-values ([(key val) (hash-iterate-key+value ht i)])
(|#%app| proc key val))
(let-values ([(key val) (hash-iterate-key+value ht i none2)])
(unless (eq? key none2)
(|#%app| proc key val)))
(loop (hash-iterate-next ht i))))])]))
(define/who hash-map
@ -421,8 +424,9 @@
(if (not i)
'()
(cons
(let-values ([(key val) (hash-iterate-key+value ht i)])
(|#%app| proc key val))
(let-values ([(key val) (hash-iterate-key+value ht i none2)])
(unless (eq? key none2)
(|#%app| proc key val)))
(loop (hash-iterate-next ht i)))))])]))
;; In sorted hash-table travesals, make some effort to sort the key.
@ -551,12 +555,15 @@
(cond
[(not i) #t]
[else
(let-values ([(key val) (hash-iterate-key+value ht1 i)])
(let ([val2 (hash-ref ht2 key none)])
(cond
[(eq? val2 none) #f]
[else (and (eql? val val2)
(loop (hash-iterate-next ht1 i)))])))])))]
(let-values ([(key val) (hash-iterate-key+value ht1 i none2)])
(if (eq? key none2)
;; Ill-timed GC => start over
(hash=? ht1 ht2 eql?)
(let ([val2 (hash-ref ht2 key none)])
(cond
[(eq? val2 none) #f]
[else (and (eql? val val2)
(loop (hash-iterate-next ht1 i)))]))))])))]
[else #f]))
@ -572,14 +579,16 @@
[else
(let* ([eq-key? (hash-eq? ht)]
[eqv-key? (and (not eq?) (hash-eqv? ht))])
(let-values ([(key val) (hash-iterate-key+value ht i)])
(let ([hc (hash-code-combine-unordered hc
(cond
[eq-key? (eq-hash-code key)]
[eqv-key? (eqv-hash-code key)]
[else (hash key)]))])
(loop (hash-code-combine-unordered hc (hash val))
(hash-iterate-next ht i)))))]))]))
(let-values ([(key val) (hash-iterate-key+value ht i none2)])
(if (eq? key none2)
(loop hc (hash-iterate-next ht i))
(let ([hc (hash-code-combine-unordered hc
(cond
[eq-key? (eq-hash-code key)]
[eqv-key? (eqv-hash-code key)]
[else (hash key)]))])
(loop (hash-code-combine-unordered hc (hash val))
(hash-iterate-next ht i))))))]))]))
;; Start by getting just a few cells via `hashtable-cells`,
@ -1354,8 +1363,9 @@
[else (make-hash)])])])
(let loop ([i (hash-iterate-first ht)])
(cond
[i (let-values ([(key val) (hash-iterate-key+value ht i)])
(hash-set! new-ht key val)
[i (let-values ([(key val) (hash-iterate-key+value ht i none2)])
(unless (eq? key none2)
(hash-set! new-ht key val))
(loop (hash-iterate-next ht i)))]
[else new-ht]))))