;;; -*- 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 ;;; . (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))))))