diff --git a/collects/racket/private/hash.rkt b/collects/racket/private/hash.rkt index 003b2c9cdb..47f55c0dfd 100644 --- a/collects/racket/private/hash.rkt +++ b/collects/racket/private/hash.rkt @@ -1,6 +1,10 @@ (module hash "pre-base.rkt" - (define (hash-keys table) - (hash-map table (λ (k v) k))) + (define (hash-keys h) + (let loop ([pos (hash-iterate-first h)]) + (if pos + (cons (hash-iterate-key h pos) + (loop (hash-iterate-next h pos))) + null))) (define (hash-values table) (hash-map table (λ (k v) v))) diff --git a/collects/tests/racket/chaperone.rktl b/collects/tests/racket/chaperone.rktl index 41b691b838..890f1658f6 100644 --- a/collects/tests/racket/chaperone.rktl +++ b/collects/tests/racket/chaperone.rktl @@ -1238,6 +1238,37 @@ (print ht o) (get-output-string o)))) +;; ---------------------------------------- +;; Check that only key-proc is called during hash-keys + +(as-chaperone-or-impersonator + ([chaperone-hash impersonate-hash]) + (let* ([h1 (make-hash (list (cons 1 2) (cons 3 4) (cons 5 6) (cons 7 8)))] + [res1 (hash-keys h1)] + [ref-proc #f] + [set-proc #f] + [remove-proc #f] + [key-proc #f] + [h2 (chaperone-hash h1 + (λ (h k) + (set! ref-proc #t) + (values k (λ (h k v) v))) + (λ (h k v) + (set! set-proc #t) + (values k v)) + (λ (h k) + (set! remove-proc #t) + k) + (λ (h k) + (set! key-proc #t) + k))] + [res2 (hash-keys h2)]) + (test #t equal? res1 res2) + (test #t values key-proc) + (test #f values ref-proc) + (test #f values set-proc) + (test #f values remove-proc))) + ;; ---------------------------------------- (report-errs)