Mercurial > hg > xemacs-beta
annotate tests/automated/weak-tests.el @ 5634:2014ff433daf
Support hash COLLECTIONs, #'{all,try}-completion{s,}; add #'test-completion
src/ChangeLog addition:
2012-01-01 Aidan Kehoe <kehoea@parhasard.net>
Add #'test-completion, API from GNU.
Accept hash table COLLECTIONs in it and in the other
completion-oriented functions, #'try-completion,
#'all-completions, and those Lisp functions implemented in terms
of them.
* lisp.h: Update the prototype of map_obarray(), making FN
compatible with the FUNCTION argument of elisp_maphash();
* abbrev.c (abbrev_match_mapper):
* abbrev.c (record_symbol):
* doc.c (verify_doc_mapper):
* symbols.c (mapatoms_1):
* symbols.c (apropos_mapper):
Update these mapper functions to reflect the new argument to
map_obarray().
* symbols.c (map_obarray):
Call FN with two arguments, the string name of the symbol, and the
symbol itself, for API (mapper) compatibility with
elisp_maphash().
* minibuf.c (map_completion): New. Map a maphash_function_t across
a non function COLLECTION, as appropriate for #'try-completion and
friends.
* minibuf.c (map_completion_list): New. Map a maphash_function_t
across a pseudo-alist, as appropriate for the completion
functions.
* minibuf.c (ignore_completion_p): PRED needs to be called with
two args if and only if the collection is a hash table. Implement
this.
* minibuf.c (try_completion_mapper): New. The loop body of
#'try-completion, refactored out.
* minibuf.c (Ftry_completion): Use try_completion_mapper(),
map_completion().
* minibuf.c (all_completions_mapper): New. The loop body of
#'all-completions, refactored out.
* minibuf.c (Fall_completions): Use all_completions_mapper(),
map_completion().
* minibuf.c (test_completion_mapper): New. The loop body of
#'test-completion.
* minibuf.c (Ftest_completion): New, API from GNU.
* minibuf.c (syms_of_minibuf): Make Ftest_completion available.
tests/ChangeLog addition:
2012-01-01 Aidan Kehoe <kehoea@parhasard.net>
* automated/completion-tests.el: New.
Test #'try-completion, #'all-completion and #'test-completion with
list, vector and hash-table COLLECTION arguments.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 01 Jan 2012 15:18:52 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 890 | 1 ;; Copyright (C) 1998 Free Software Foundation, Inc. |
| 2 | |
| 3 ;; Author: Mike Sperber <mike@xemacs.org> | |
| 4 ;; Maintainer: Mike Sperber <mike@xemacs.org> | |
| 5 ;; Created: 2002 | |
| 6 ;; Keywords: tests, database | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; option) any later version. |
| 890 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; for more details. |
| 890 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 890 | 22 |
| 23 ;;; Synched up with: Not in FSF. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 1636 | 27 ;;; Test implementation of weak boxes, ephemerons, and weak lists |
| 890 | 28 ;;; See test-harness.el |
| 29 | |
| 30 (condition-case err | |
| 31 (require 'test-harness) | |
| 32 (file-error | |
| 33 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 34 (push (file-name-directory load-file-name) load-path) | |
| 35 (require 'test-harness)))) | |
| 36 | |
| 37 (garbage-collect) | |
| 1636 | 38 |
| 39 ;; tests for weak-boxes | |
| 890 | 40 (let ((w (make-weak-box (cons 2 3)))) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
41 (Assert (equal (cons 2 3) (weak-box-ref w))) |
| 890 | 42 (garbage-collect) |
| 43 (Assert (not (weak-box-ref w)))) | |
| 44 | |
| 45 (garbage-collect) | |
| 46 | |
| 1636 | 47 ;; tests for ephemerons |
| 890 | 48 (let* ((p (cons 3 4)) |
| 49 (finalized-p nil) | |
| 50 (eph1 (make-ephemeron (cons 1 2) p | |
| 4021 | 51 #'(lambda (value) |
| 52 (setq finalized-p t)))) | |
| 890 | 53 (eph2 (make-ephemeron p p))) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
54 (Assert (eq p (ephemeron-ref (make-ephemeron (cons 1 2) p)))) |
| 890 | 55 (Assert (ephemeron-p (make-ephemeron (cons 1 2) p))) |
| 56 | |
| 57 (garbage-collect) | |
| 58 (garbage-collect) ; ensure the post-gc hook runs | |
| 59 | |
| 60 (Assert finalized-p) | |
| 61 (Assert (not (ephemeron-ref eph1))) | |
| 62 | |
| 63 (garbage-collect) | |
| 64 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
65 (Assert (eq p (ephemeron-ref eph2)))) |
| 890 | 66 |
| 1636 | 67 (garbage-collect) |
| 68 | |
| 69 ;; tests for simple weak-lists | |
| 70 (let* ((a (cons 23 42)) | |
| 71 (b (cons 42 65)) | |
| 72 (testlist (list a b)) | |
| 73 (weaklist1 (make-weak-list 'simple)) | |
| 74 (weaklist2 (make-weak-list 'simple)) | |
| 75 (weaklist3 (make-weak-list 'simple)) | |
| 76 (weaklist4 (make-weak-list 'simple))) | |
| 77 (set-weak-list-list weaklist1 testlist) | |
| 78 (set-weak-list-list weaklist2 (list (cons 1 2) a b)) | |
| 79 (set-weak-list-list weaklist3 (list a (cons 1 2) b)) | |
| 80 (set-weak-list-list weaklist4 (list a b (cons 1 2))) | |
| 81 (Assert (weak-list-p weaklist1)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
82 (Assert (eq (weak-list-type weaklist1) 'simple)) |
| 1636 | 83 (Assert (weak-list-p weaklist2)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
84 (Assert (eq (weak-list-type weaklist2) 'simple)) |
| 1636 | 85 (Assert (weak-list-p weaklist3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
86 (Assert (eq (weak-list-type weaklist3) 'simple)) |
| 1636 | 87 (Assert (weak-list-p weaklist4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
88 (Assert (eq (weak-list-type weaklist4) 'simple)) |
| 1636 | 89 |
| 90 (garbage-collect) | |
| 91 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
92 (Assert (eq (weak-list-list weaklist1) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
93 (Assert (equal (weak-list-list weaklist2) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
94 (Assert (equal (weak-list-list weaklist3) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
95 (Assert (equal (weak-list-list weaklist4) testlist))) |
| 1636 | 96 |
| 97 (garbage-collect) | |
| 98 | |
| 99 ;; tests for assoc weak-lists | |
| 100 (let* ((a (cons 23 42)) | |
| 101 (b (cons a a)) | |
| 102 (testlist (list b b)) | |
| 103 (weaklist1 (make-weak-list 'assoc)) | |
| 104 (weaklist2 (make-weak-list 'assoc)) | |
| 105 (weaklist3 (make-weak-list 'assoc)) | |
| 106 (weaklist4 (make-weak-list 'assoc))) | |
| 107 (set-weak-list-list weaklist1 testlist) | |
| 108 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 109 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 110 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 111 (Assert (weak-list-p weaklist1)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
112 (Assert (eq (weak-list-type weaklist1) 'assoc)) |
| 1636 | 113 (Assert (weak-list-p weaklist2)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
114 (Assert (eq (weak-list-type weaklist2) 'assoc)) |
| 1636 | 115 (Assert (weak-list-p weaklist3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
116 (Assert (eq (weak-list-type weaklist3) 'assoc)) |
| 1636 | 117 (Assert (weak-list-p weaklist4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
118 (Assert (eq (weak-list-type weaklist4) 'assoc)) |
| 1636 | 119 |
| 120 (garbage-collect) | |
| 121 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
122 (Assert (eq (weak-list-list weaklist1) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
123 (Assert (equal (weak-list-list weaklist2) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
124 (Assert (equal (weak-list-list weaklist3) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
125 (Assert (equal (weak-list-list weaklist4) testlist))) |
| 1636 | 126 |
| 127 (garbage-collect) | |
| 128 | |
| 129 ;; tests for key-assoc weak-lists | |
| 130 (let* ((a (cons 23 42)) | |
| 131 (b (cons a a)) | |
| 132 (testlist (list b b)) | |
| 133 (weaklist1 (make-weak-list 'key-assoc)) | |
| 134 (weaklist2 (make-weak-list 'key-assoc)) | |
| 135 (weaklist3 (make-weak-list 'key-assoc)) | |
| 136 (weaklist4 (make-weak-list 'key-assoc))) | |
| 137 (set-weak-list-list weaklist1 testlist) | |
| 138 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 139 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 140 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 141 (Assert (weak-list-p weaklist1)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
142 (Assert (eq (weak-list-type weaklist1) 'key-assoc)) |
| 1636 | 143 (Assert (weak-list-p weaklist2)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
144 (Assert (eq (weak-list-type weaklist2) 'key-assoc)) |
| 1636 | 145 (Assert (weak-list-p weaklist3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
146 (Assert (eq (weak-list-type weaklist3) 'key-assoc)) |
| 1636 | 147 (Assert (weak-list-p weaklist4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
148 (Assert (eq (weak-list-type weaklist4) 'key-assoc)) |
| 1636 | 149 |
| 150 (garbage-collect) | |
| 151 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
152 (Assert (eq (weak-list-list weaklist1) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
153 (Assert (equal (weak-list-list weaklist2) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
154 (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
155 (Assert (equal (weak-list-list weaklist4) testlist))) |
| 1636 | 156 |
| 157 (garbage-collect) | |
| 158 | |
| 159 ;; tests for value-assoc weak-lists | |
| 160 (let* ((a (cons 23 42)) | |
| 161 (b (cons a a)) | |
| 162 (testlist (list b b)) | |
| 163 (weaklist1 (make-weak-list 'value-assoc)) | |
| 164 (weaklist2 (make-weak-list 'value-assoc)) | |
| 165 (weaklist3 (make-weak-list 'value-assoc)) | |
| 166 (weaklist4 (make-weak-list 'value-assoc))) | |
| 167 (set-weak-list-list weaklist1 testlist) | |
| 168 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 169 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 170 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 171 (Assert (weak-list-p weaklist1)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
172 (Assert (eq (weak-list-type weaklist1) 'value-assoc)) |
| 1636 | 173 (Assert (weak-list-p weaklist2)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
174 (Assert (eq (weak-list-type weaklist2) 'value-assoc)) |
| 1636 | 175 (Assert (weak-list-p weaklist3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
176 (Assert (eq (weak-list-type weaklist3) 'value-assoc)) |
| 1636 | 177 (Assert (weak-list-p weaklist4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
178 (Assert (eq (weak-list-type weaklist4) 'value-assoc)) |
| 1636 | 179 |
| 180 (garbage-collect) | |
| 181 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
182 (Assert (eq (weak-list-list weaklist1) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
183 (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
184 (Assert (equal (weak-list-list weaklist3) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
185 (Assert (equal (weak-list-list weaklist4) testlist))) |
| 1636 | 186 |
| 187 (garbage-collect) | |
| 188 | |
| 189 ;; tests for full-assoc weak-lists | |
| 190 (let* ((a (cons 23 42)) | |
| 191 (b (cons a a)) | |
| 192 (testlist (list b b)) | |
| 193 (weaklist1 (make-weak-list 'full-assoc)) | |
| 194 (weaklist2 (make-weak-list 'full-assoc)) | |
| 195 (weaklist3 (make-weak-list 'full-assoc)) | |
| 196 (weaklist4 (make-weak-list 'full-assoc))) | |
| 197 (set-weak-list-list weaklist1 testlist) | |
| 198 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 199 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 200 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 201 (Assert (weak-list-p weaklist1)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
202 (Assert (eq (weak-list-type weaklist1) 'full-assoc)) |
| 1636 | 203 (Assert (weak-list-p weaklist2)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
204 (Assert (eq (weak-list-type weaklist2) 'full-assoc)) |
| 1636 | 205 (Assert (weak-list-p weaklist3)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
206 (Assert (eq (weak-list-type weaklist3) 'full-assoc)) |
| 1636 | 207 (Assert (weak-list-p weaklist4)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
208 (Assert (eq (weak-list-type weaklist4) 'full-assoc)) |
| 1636 | 209 |
| 210 (garbage-collect) | |
| 211 | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
212 (Assert (eq (weak-list-list weaklist1) testlist)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
213 (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
214 (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
215 (Assert (equal (weak-list-list weaklist4) testlist))) |
| 1636 | 216 |
| 217 (garbage-collect) | |
|
1773
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
218 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
219 ;; test the intended functionality of the fixpoint iteration used for marking |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
220 ;; weak data structures like the ephermerons. Basically this tests gc_internals |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
221 ;; to work properly but it also ensures the ephemerons behave according to the |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
222 ;; specification |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
223 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
224 (let* ((inner_cons (cons 1 2)) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
225 (weak1 (make-ephemeron inner_cons |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
226 (make-ephemeron inner_cons |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
227 (cons 1 2) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
228 '(lambda (v) t)) |
| 4021 | 229 #'(lambda (v) t)))) |
|
1773
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
230 (Assert (ephemeron-ref (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
231 (garbage-collect) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
232 ;; assure the inner ephis are still there |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
233 (Assert (ephemeron-ref (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
234 ;; delete the key reference and force cleaning up the garbage |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
235 (setq inner_cons (cons 3 4)) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
236 (garbage-collect) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
237 (Assert (not (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
238 ) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
239 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
240 (garbage-collect) |