mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-04 11:10:27 +02:00
d457aaa57d
* libguile/ephemerons.c (scm_make_ephemeron): Relax restriction that key
be a heap object. It's too annoying otherwise.
(scm_c_ephemeron_table_clear_x):
(scm_ephemeron_table_clear_x): New interface.
* module/ice-9/ephemerons.scm: Expose ephemeron-table-clear!.
* test-suite/tests/ephemerons.test ("ephemerons"): Update tests.
81 lines
2.9 KiB
Scheme
81 lines
2.9 KiB
Scheme
;;; -*- scheme -*-
|
||
;;; Copyright (C) 2025 Free Software Foundation, Inc.
|
||
;;;
|
||
;;; This library is free software: you can redistribute it and/or modify
|
||
;;; it under the terms of the GNU Lesser General Public License as
|
||
;;; published by the Free Software Foundation, either version 3 of the
|
||
;;; License, or (at your option) any later version.
|
||
;;;
|
||
;;; This library is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
;;; Lesser General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU Lesser General Public
|
||
;;; License along with this program. If not, see
|
||
;;; <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (test-ephemerons)
|
||
#:use-module (test-suite lib)
|
||
#:use-module (ice-9 ephemerons))
|
||
|
||
|
||
(with-test-prefix "ephemerons"
|
||
|
||
(pass-if (not (ephemeron? 42)))
|
||
(pass-if (not (ephemeron? (cons 42 42))))
|
||
(pass-if (ephemeron? (make-ephemeron (cons 42 42) 42)))
|
||
|
||
(with-test-prefix "ephemeron key not heap object"
|
||
(pass-if "fixnum" (ephemeron? (make-ephemeron 42 42)))
|
||
(pass-if "char" (ephemeron? (make-ephemeron #\a 42)))
|
||
(pass-if "bool" (ephemeron? (make-ephemeron #f 42)))
|
||
(pass-if "bool" (ephemeron? (make-ephemeron #t 42))))
|
||
|
||
(let ((x (cons 42 69)))
|
||
(define e (make-ephemeron x 100))
|
||
(gc)
|
||
(gc)
|
||
(gc)
|
||
(pass-if (ephemeron? e))
|
||
(pass-if (eq? x (ephemeron-key e)))
|
||
(pass-if-equal 100 (ephemeron-value e))
|
||
(pass-if-equal 100 (ephemeron-swap! e 'qux))
|
||
(pass-if-equal 'qux (ephemeron-value e))
|
||
|
||
(ephemeron-mark-dead! e)
|
||
(pass-if (ephemeron? e))
|
||
(pass-if-equal #f (ephemeron-key e))
|
||
(pass-if-equal #f (ephemeron-value e))))
|
||
|
||
(with-test-prefix "ephemeron tables"
|
||
|
||
(define et (make-ephemeron-table 47))
|
||
(pass-if (ephemeron-table? et))
|
||
|
||
(define keys (map list (iota 47)))
|
||
|
||
(for-each (lambda (idx)
|
||
(pass-if (not (ephemeron-table-ref et idx))))
|
||
(iota 47))
|
||
(for-each (lambda (idx key)
|
||
(ephemeron-table-push! et idx (make-ephemeron key #t)))
|
||
(iota 47) keys)
|
||
(for-each (lambda (idx)
|
||
(define head (ephemeron-table-ref et idx))
|
||
(pass-if (ephemeron? head))
|
||
(pass-if-equal (list idx) (ephemeron-key head))
|
||
(pass-if (ephemeron-value head))
|
||
(pass-if (not (ephemeron-next head))))
|
||
(iota 47))
|
||
|
||
(define prev (ephemeron-table-ref et 42))
|
||
(pass-if-equal prev
|
||
(ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) #f))
|
||
(pass-if-equal prev
|
||
(ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) prev))
|
||
(pass-if-equal 'hey (ephemeron-key (ephemeron-table-ref et 42)))
|
||
(pass-if-equal prev (ephemeron-next (ephemeron-table-ref et 42)))
|
||
(pass-if-equal (list 42)
|
||
(ephemeron-key (ephemeron-next (ephemeron-table-ref et 42))))
|
||
(pass-if (not (ephemeron-next (ephemeron-next (ephemeron-table-ref et 42))))))
|