diff --git a/quad2/attr.rkt b/quad2/attr.rkt index be5919a4..6680b9ff 100644 --- a/quad2/attr.rkt +++ b/quad2/attr.rkt @@ -12,6 +12,9 @@ "param.rkt") (provide (all-defined-out)) +(module+ test + (require rackunit)) + (define (for-each-attrs xs proc) ;; apply `proc` to each set of attrs in `xs`. ;; recursively descend from top to bottom. @@ -20,11 +23,11 @@ (let loop ([xs xs][parent-attrs #false]) (for ([x (in-list xs)] #:when (quad? x)) - (define attrs (quad-attrs x)) - (unless (set-member? attrs-seen attrs) - (proc attrs parent-attrs) - (set-add! attrs-seen attrs)) - (loop (quad-elems x) attrs)))) + (define attrs (quad-attrs x)) + (unless (set-member? attrs-seen attrs) + (proc attrs parent-attrs) + (set-add! attrs-seen attrs)) + (loop (quad-elems x) attrs)))) (define (do-attr-iteration qs #:which-attr [which-attr 'all-attributes-signal] @@ -41,13 +44,19 @@ [other (raise-argument-error 'do-attr-iteration "key predicate" other)])) (for-each-attrs qs (λ (attrs parent-attrs) - (for ([(ak av) (in-hash attrs)] - #:when (attr-predicate ak av)) - (match (if wants-parent-attrs? (attr-proc ak av attrs parent-attrs) (attr-proc ak av attrs)) - ;; void value: do nothing - [(? void?) (void)] - ;; otherwise treat return value as new attr value - [new-av (hash-set! attrs ak new-av)]))))) + ;; we don't iterate with `in-hash` (or `in-hash-keys`) because + ;; `attrs` might get mutated during the loop, + ;; which invalidates the reference `in-hash` is using + (for* ([ak (in-list (hash-keys attrs))] + [av (in-value (hash-ref attrs ak))] + #:when (attr-predicate ak av)) + (match (if wants-parent-attrs? + (attr-proc ak av attrs parent-attrs) + (attr-proc ak av attrs)) + ;; void value: do nothing + [(? void?) (void)] + ;; otherwise treat return value as new attr value + [new-av (hash-set! attrs ak new-av)]))))) (define-pass (upgrade-attr-keys qs) ;; convert attr keys from symbols to attr struct types @@ -55,16 +64,15 @@ #:pre (list-of quad?) #:post (list-of quad?) (define attr-lookup-table (for/hasheq ([a (in-list (current-attrs))]) - (values (attr-key-name a) a))) + (values (attr-key-name a) a))) (define strict-attrs? (current-strict-attrs?)) (define (do-upgrade ak av attrs) (cond [(attr-key? ak) av] [(symbol? ak) (match (hash-ref attr-lookup-table ak :unknown-key) - [(== :unknown-key eq?) - #:when strict-attrs? - (raise-argument-error 'upgrade-attr-keys "known attr" ak)] + [(== :unknown-key eq?) #:when strict-attrs? + (raise-argument-error 'upgrade-attr-keys "known attr" ak)] [attr-key (hash-remove! attrs ak) (hash-set! attrs attr-key av)])] @@ -77,7 +85,7 @@ (define mandatory-keys (filter attr-key-mandatory? (current-attrs))) (for-each-attrs qs (λ (attrs parent-attrs) (for ([ak (in-list mandatory-keys)]) - (hash-ref! attrs ak (attr-key-default ak)))))) + (hash-ref! attrs ak (attr-key-default ak)))))) (define-pass (downcase-string-attr-values qs) ;; make attribute values lowercase, unless they're case-sensitive @@ -150,7 +158,6 @@ #:attr-proc (λ (ak av attrs) (parse-dimension av)))) (module+ test - (require rackunit) (define-attr-list debug-attrs [:foo (make-attr-cased-string-key 'foo)] [:ps (make-attr-path-key 'ps)]