source: trunk/abcl/test/lisp/abcl/weak-hash-tables.lisp @ 13309

Last change on this file since 13309 was 13309, checked in by Mark Evenson, 10 years ago

Implementation of hashtables with weak keys and/or values.

MAKE-HASH-TABLE now has an optional :WEAKNESS argument that can take
the values :KEY, :VALUE, :KEY-AND-VALUE, or :KEY-OR-VALUE. :KEY means
that the key of an entry must be live to guarantee that the entry is
preserved. VALUE means that the value of an entry must be live to
guarantee that the entry is preserved. :KEY-AND-VALUE means that both
the key and the value must be live to guarantee that the entry is
preserved. :KEY-OR-VALUE means that either the key or the value must
be live to guarantee that the entry is preserved.

The tests simply excercise the various types of weak hash tables
enough that a GC phase should show that the table indeed does decrease
in size.

Changed the defition of functions in HashTableFunctions? to match
current docstring/pf_XXX() naming conventions.

This implementation is only lightly tested in single-threaded use, and
untested in multiple threading scenarios.

Addresses ticket:140.

File size: 2.4 KB
Line 
1(in-package #:abcl.test.lisp)
2
3#|
4(deftest weak-hash-table.1
5    (labels ((random-key ()
6               (coerce (/ (random 10000) (random 10000))
7                       'single-float)))
8    (let ((ht (make-hash-table :weakness :keys))
9      (dotimes (i 1000)
10        (setf (gethash (random-key) ht) (random 100000))
11        (sys::hash-table-entries ht)
12
13|#
14
15(defun random-object ()
16  "A randomly constructed object that is elgible for garbage collection."
17  (coerce (/ (random 10000) (1+ (random 10000)))
18          'single-float))
19
20(deftest weak-hash-table.1 
21  (let* ((ht (make-hash-table :weakness :key))
22         (entries 0))
23    (dotimes (i 100000) 
24      (setf (gethash (random-object) ht) (random 100000))
25      (let ((new-entries (sys::hash-table-count ht)))
26        (when (and new-entries
27                   (> entries new-entries))
28          (format t "~&Previously ~A entries, now ~A." 
29                  entries new-entries))
30        (setf entries new-entries))))
31    nil)
32
33(deftest weak-hash-table.2 
34    (let* ((ht (make-hash-table :weakness :value))
35           (entries 0))
36      (dotimes (i 100000) 
37        (setf (gethash (random-object) ht) (random 100000))
38        (let ((new-entries (sys::hash-table-count ht)))
39          (when (and new-entries
40                     (> entries new-entries))
41            (format t "~&Previously ~A entries, now ~A." 
42                    entries new-entries))
43          (setf entries new-entries))))
44    nil)
45
46(deftest weak-hash-table.3
47    (let* ((ht (make-hash-table :weakness :key-and-value))
48           (entries 0))
49      (dotimes (i 100000) 
50        (setf (gethash (random-object) ht) (random 100000))
51        (let ((new-entries (sys::hash-table-count ht)))
52          (when (and new-entries
53                     (> entries new-entries))
54            (format t "~&Previously ~A entries, now ~A." 
55                    entries new-entries))
56          (setf entries new-entries))))
57    nil)
58
59(deftest weak-hash-table.4
60    (let* ((ht (make-hash-table :weakness :key-or-value))
61           (entries 0))
62      (dotimes (i 100000) 
63        (setf (gethash (random-object) ht) (random 100000))
64        (let ((new-entries (sys::hash-table-count ht)))
65          (when (and new-entries
66                     (> entries new-entries))
67            (format t "~&Previously ~A entries, now ~A." 
68                    entries new-entries))
69          (setf entries new-entries))))
70    nil)
71
72
73           
74 
75
76
Note: See TracBrowser for help on using the repository browser.