Add a comment to fns-tests-weak-equal-table

* test/src/fns-tests.el (ft--gc): Execute finalizers only when
requested.
This commit is contained in:
Helmut Eller 2026-06-08 17:48:38 +02:00
parent 5f9b9dda08
commit d150f9800d

View file

@ -1318,11 +1318,12 @@
(should (= (length expected) (length actual)))
(should (= (hash-table-count table) (length expected)))))
(defun ft--gc (_weakness)
(defun ft--gc (execute-finalizers)
(cond ((fboundp 'igc--collect)
(igc-collect)
(igc--process-messages)
(igc-collect))
(when execute-finalizers
(igc--process-messages)
(igc-collect)))
(t
(garbage-collect))))
@ -1336,7 +1337,7 @@
(table (make-hash-table :weakness weakness))
(f (lambda () (ft--populate-hashtable table (ft--nentries))))
(pairs (thread-join (make-thread f))))
(ft--gc weakness)
(ft--gc t)
(ft--check-entries table pairs)))
(ert-deftest ft-weak-key-removal () (ft--test-weak-removal 'key))
@ -1387,7 +1388,7 @@
(let ((h (make-hash-table :weakness weakness :test test)))
(dotimes (i 32)
(puthash i (lognot 2) h))
(ft--gc weakness)))
(ft--gc t)))
(ert-deftest ft-weak-fixnums ()
(dolist (w '(key value key-and-value key-or-value))
@ -1404,7 +1405,7 @@
(puthash i (cons nil nil) h)))
(#b10 (dotimes (i 10)
(puthash (cons nil nil) i h)))))
(ft--gc weakness)))
(ft--gc t)))
(ert-deftest ft-weak-fixnums2 ()
(dolist (w '(key value key-and-value key-or-value))
@ -1417,7 +1418,7 @@
(dotimes (i n)
(let* ((obj (cons 'a i)))
(puthash obj obj h)))
(ft--gc weakness)
(ft--gc t)
(should (< (length (ft--hash-table-entries h)) n))
(should (< (hash-table-count h) n))))
@ -1425,6 +1426,9 @@
(dolist (w '(key value key-and-value key-or-value))
(ft--test-ephemeron-table w)))
;; This test is supposed to show a problem when finalizers are used to
;; remove hash table entries. It's incorrect to "arm" the finalizer as
;; long as the entry can be "reached" by using an equal key.
(ert-deftest ft-weak-equal-table ()
(unless (featurep 'threads)
(ert-skip '(not (featurep 'threads))))
@ -1436,10 +1440,10 @@
(val (list 'val i)))
(puthash key val h)))
(should (= (hash-table-count h) n))
(ft--gc 'key)
(ft--gc nil)
(setq root (thread-join (make-thread (lambda ()
(gethash '(key 0) h)))))
(ft--gc 'key-or-value)
(ft--gc t)
(should (< (hash-table-count h) n))
(should (equal root (gethash '(key 0) h)))))