Reference implementation attempts to mutate possibly immutable hash table.
Zhu Zihao 11 Jul 2025 17:38 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