blob: f37c0ff3b15e4acd39a1ef8e6558c5aa7be9b7b6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;;; -*- 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))))))
|