summaryrefslogtreecommitdiff
path: root/test-suite/tests/ephemerons.test
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))))))