Reference implementation attempts to mutate possibly immutable hash table. Zhu Zihao (11 Jul 2025 17:54 UTC)
|
||
Re: Reference implementation attempts to mutate possibly immutable hash table.
Marc Nieper-Wißkirchen
(11 Jul 2025 18:51 UTC)
|
||
(missing)
|
||
Re: Reference implementation attempts to mutate possibly immutable hash table.
Zhu Zihao
(11 Jul 2025 20:28 UTC)
|
||
Re: Reference implementation attempts to mutate possibly immutable hash table.
Arthur A. Gleckler
(11 Jul 2025 20:36 UTC)
|
While packaging SRFI-165 for Guix, I found 4 of tests [SRFI-165-test] are failed. These tests are all try to mutate an immutable hash-table, take 1 as an example: Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 91 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-ref env x))) Test end: result-kind: fail actual-value: #f actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f) expected-value: 42 This is probably caused by attempting to mutate an immutable hash-table created by 'hash-table' procedure in SRFI-125 [SRFI-125-spec]. At line 85, the source is ``` (define-syntax %define-computation-type (syntax-rules () ((_ make-environment run () n ((var default e immutable i) ...)) (begin (define-values (e ...) (values default ...)) (define var (make-environment-variable 'var e immutable i)) ... (define (make-environment) (let ((env (make-vector (+ n 2)))) (environment-set-global! env (hash-table variable-comparator)) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (environment-set-local! env (mapping variable-comparator)) (vector-set! env (+ i 2) (box e)) ``` And at line 134, the source is ``` (define (computation-environment-update! env var val) (if (predefined? var) (set-box! (environment-cell env var) val) (mapping-ref (environment-local env) var (lambda () (hash-table-set! (environment-global env) var val)) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (lambda (cell) (set-box! cell val))))) ``` SRFI-125 specification says: ``` (hash-table comparator [ key value ] ...) Returns a newly allocated hash table, created as if by make-hash-table using comparator. For each pair of arguments, an association is added to the new hash table with key as its key and value as its value. If the implementation supports immutable hash tables, this procedure returns an immutable hash table. If the same key (in the sense of the equality predicate) is specified more than once, it is an error. ``` And the reference implementation of SRFI-125 [SRFI-125-source] does return the immutable one, when attempting to mutate it, Guile raise an exception. I'm not sure how to fix it, SRFI-125 doesn't provides a good way to create mutable hash-table (we can only create an immutable one, and copy it as mutable). Maybe use `make-hash-table`, but it's a deprecated interface. [SRFI-165-test]: https://gitlab.com/nieper/show/-/blob/master/srfi/165/test.sld?ref_type=heads [SRFI-125-spec]: https://srfi.schemers.org/srfi-125/srfi-125.html [SRFI-125-source]: https://github.com/scheme-requests-for-implementation/srfi-125/blob/master/srfi/125.body.scm#L257 Full log attached below:
%%%% Starting test SRFI 165 Group begin: SRFI 165 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 36 source-form: (test-assert (not (eqv? (make-computation-environment-variable (quote x) #f #f) (make-computation-environment-variable (quote x) #f #f)))) Test end: result-kind: pass actual-value: #t Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 39 source-form: (test-assert (make-computation-environment)) Test end: result-kind: pass actual-value: #(#hasheq() #<<mapping> comparator: #<comparator type-test: #<procedure %environment-variable?-procedure (obj)> equality: #<procedure eq? (#:optional _ _ . _)> ordering: #<procedure 7f07539cbee0 at srfi/srfi-165/165-impl.scm:44:19 (x y)> hash: #<procedure 7f07539cbec0 at srfi/srfi-165/165-impl.scm:47:19 (x . y)> ordering?: #t hash?: #t> tree: #(black #f #f #f)>) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 41 source-form: (test-assert (make-environment)) Test end: result-kind: pass actual-value: #(#hasheq() #<<mapping> comparator: #<comparator type-test: #<procedure %environment-variable?-procedure (obj)> equality: #<procedure eq? (#:optional _ _ . _)> ordering: #<procedure 7f07539cbee0 at srfi/srfi-165/165-impl.scm:44:19 (x y)> hash: #<procedure 7f07539cbec0 at srfi/srfi-165/165-impl.scm:47:19 (x . y)> ordering?: #t hash?: #t> tree: #(black #f #f #f)> #<box 7f0752577520#f> #<box 7f0752577510#f>) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 43 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-environment-ref (make-computation-environment) x))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 47 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) 42 #f))) (computation-environment-ref (make-computation-environment) x))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 51 source-form: (test-eqv #f (computation-environment-ref (make-environment) z)) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 54 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42) x))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 60 source-form: (test-eqv 10 (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42 y 10) y))) Test end: result-kind: pass actual-value: 10 expected-value: 10 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 67 source-form: (test-eqv 42 (computation-environment-ref (computation-environment-update (make-environment) z 42) z)) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 72 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-computation-environment) x 42) y))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 79 source-form: (test-eqv #f (let ((y (make-computation-environment-variable (quote y) #f #f))) (computation-environment-ref (computation-environment-update (make-environment) z 42) y))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 85 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update env x 42) (computation-environment-ref env x))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 91 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-ref env x))) Test end: result-kind: fail actual-value: #f actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f) expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 97 source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! env z 42) (computation-environment-ref env z))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 102 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! env x 42) (computation-environment-update env x 10) (computation-environment-ref env x))) Test end: result-kind: fail actual-value: #f actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f) expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 109 source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! env z 42) (computation-environment-update env z 10) (computation-environment-ref env z))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 115 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f)) (env (make-computation-environment))) (computation-environment-update! (computation-environment-update env x 10) x 42) (computation-environment-ref env x))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 122 source-form: (test-eqv #f (let ((env (make-environment))) (computation-environment-update! (computation-environment-update env z 10) z 42) (computation-environment-ref env z))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 128 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f)) (env (make-computation-environment))) (computation-environment-update! (computation-environment-update env y 10) x 42) (computation-environment-ref env x))) Test end: result-kind: fail actual-value: #f actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f) expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 136 source-form: (test-eqv 42 (let ((env (make-environment))) (computation-environment-update! (computation-environment-update env w 10) z 42) (computation-environment-ref env z))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 142 source-form: (test-eqv 42 (let* ((x (make-computation-environment-variable (quote x) #f #f)) (env (computation-environment-update (make-computation-environment) x 42)) (copy (computation-environment-copy env))) (computation-environment-update! env x 10) (computation-environment-ref copy x))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 150 source-form: (test-eqv 42 (let* ((env (computation-environment-update (make-environment) z 42)) (copy (computation-environment-copy env))) (computation-environment-update! env z 10) (computation-environment-ref copy z))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 157 source-form: (test-eqv #f (let ((flag #f)) (make-computation (lambda (compute) (set! flag #t))) flag)) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 164 source-form: (test-eqv 42 (computation-run (make-computation (lambda (compute) 42)))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 169 source-form: (test-eqv 42 (computation-run (make-computation (lambda (compute) (compute (computation-pure 42)))))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 174 source-form: (test-equal (quote (10 42)) (call-with-values (lambda () (computation-run (make-computation (lambda (compute) (compute (computation-pure 10 42)))))) list)) Test end: result-kind: pass actual-value: (10 42) expected-value: (10 42) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 182 source-form: (test-equal (quote (42 (b a))) (let* ((acc (quote ())) (result (computation-run (computation-each (make-computation (lambda (compute) (set! acc (cons (quote a) acc)))) (make-computation (lambda (compute) (set! acc (cons (quote b) acc)) 42)))))) (list result acc))) Test end: result-kind: pass actual-value: (42 (b a)) expected-value: (42 (b a)) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 194 source-form: (test-equal (quote (42 (b a))) (let* ((acc (quote ())) (result (computation-run (computation-each-in-list (list (make-computation (lambda (compute) (set! acc (cons (quote a) acc)))) (make-computation (lambda (compute) (set! acc (cons (quote b) acc)) 42))))))) (list result acc))) Test end: result-kind: pass actual-value: (42 (b a)) expected-value: (42 (b a)) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 207 source-form: (test-equal 83 (computation-run (computation-bind (computation-pure 42) (lambda (x) (computation-pure (* x 2))) (lambda (x) (computation-pure (- x 1)))))) Test end: result-kind: pass actual-value: 83 expected-value: 83 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 214 source-form: (test-equal (list 42 84) (computation-run (computation-sequence (list (computation-pure 42) (computation-pure 84))))) Test end: result-kind: pass actual-value: (42 84) expected-value: (42 84) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 219 source-form: (test-equal (quote (42 #f)) (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (make-computation (lambda (compute) (let ((a (compute (computation-local (lambda (env) (computation-environment-update env x 42)) (computation-bind (computation-ask) (lambda (env) (computation-pure (computation-environment-ref env x)))))))) (list a (computation-environment-ref (compute (computation-ask)) x)))))))) Test end: result-kind: pass actual-value: (42 #f) expected-value: (42 #f) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 235 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 42)) (computation-fn ((y x)) (computation-pure y)))))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 241 source-form: (test-eqv 42 (run (computation-with ((z 42)) (computation-fn ((y z)) (computation-pure y))))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 246 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 42)) (computation-fn (x) (computation-pure x)))))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 252 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-each (computation-with ((x 42)) (computation-fn ((y x)) (computation-pure y))) (computation-fn ((y x)) (computation-pure y)))))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 260 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-each (computation-with! (x 42)) (computation-fn ((y x)) (computation-pure y)))))) Test end: result-kind: fail actual-value: #f actual-error: (misc-error #f "Hashtable is immutable. ~S" (#hasheq()) #f) expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 266 source-form: (test-eqv #f (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-forked (computation-with! (x 42)) (computation-fn ((y x)) (computation-pure y)))))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 272 source-form: (test-equal (list #f 2) (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-bind/forked (computation-each (computation-with! (x 42)) (computation-pure 2)) (lambda (z) (computation-fn ((y x)) (computation-pure (list y z)))))))) Test end: result-kind: pass actual-value: (#f 2) expected-value: (#f 2) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 282 source-form: (test-eqv 42 (computation-run (computation-with ((default-computation computation-pure)) 42))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 288 source-form: (test-eqv 42 (let ((x (make-computation-environment-variable (quote x) #f #f))) (computation-run (computation-with ((x 10)) (computation-with ((x 42)) (computation-fn ((x x)) (computation-pure x))))))) Test end: result-kind: pass actual-value: 42 expected-value: 42 Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 295 source-form: (test-equal (list 10 42) (let ((x (make-computation-environment-variable (quote x) #f #f)) (y (make-computation-environment-variable (quote y) #f #f))) (computation-run (computation-with ((x 10) (y 42)) (computation-fn (x y) (computation-pure (list x y))))))) Test end: result-kind: pass actual-value: (10 42) expected-value: (10 42) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 302 source-form: (test-equal (list 10 42) (run (computation-with ((z 10) (w 42)) (computation-fn (z w) (computation-pure (list z w)))))) Test end: result-kind: pass actual-value: (10 42) expected-value: (10 42) Test begin: source-file: "/home/citreu/gitrepos/mnieper-show/srfi/165/test.sld" source-line: 307 source-form: (test-equal (list 10 42) (let () (define-computation-type make-environment run (x 10) (y 42 "immutable")) (run (computation-fn (x y) (computation-pure (list x y)))))) Test end: result-kind: pass actual-value: (10 42) expected-value: (10 42) Group end: SRFI 165 # of expected passes 39 # of unexpected failures 4
-- Retrieve my PGP public key: 执行下列命令以获取我的 PGP 公有密钥: gpg --recv-keys B3EBC086AB0EBC0F45E0B4D433DB374BCEE4D9DC Zihao