Mercurial > hg > xemacs-beta
annotate tests/automated/weak-tests.el @ 2227:8e7b4a0c1a81
[xemacs-hg @ 2004-08-21 17:05:49 by michaels]
2004-08-15 Jan Rychter <jwr@xemacs.org>
* window-xemacs.el (really-set-window-configuration): deal
gracefully with the case when the buffer previously saved in the
configuration (and that we want to switch to) has been
killed. Switch to the next buffer on the buffer-list in that case.
| author | michaels |
|---|---|
| date | Sat, 21 Aug 2004 17:05:51 +0000 |
| parents | aa0db78e67c4 |
| children | cef5f57bb9e2 |
| 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 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 23 ;; 02111-1307, USA. | |
| 24 | |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 1636 | 29 ;;; Test implementation of weak boxes, ephemerons, and weak lists |
| 890 | 30 ;;; See test-harness.el |
| 31 | |
| 32 (condition-case err | |
| 33 (require 'test-harness) | |
| 34 (file-error | |
| 35 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 36 (push (file-name-directory load-file-name) load-path) | |
| 37 (require 'test-harness)))) | |
| 38 | |
| 1758 | 39 (when test-harness-test-compiled |
| 40 ;; this ha-a-ack depends on the compiled test coming last | |
| 41 (setq test-harness-failure-tag | |
| 42 "KNOWN BUG - fix reverted; after 2003-10-31 bitch at stephen\n")) | |
| 43 | |
| 890 | 44 (garbage-collect) |
| 1636 | 45 |
| 46 ;; tests for weak-boxes | |
| 890 | 47 (let ((w (make-weak-box (cons 2 3)))) |
| 48 (Assert (equal (cons 2 3) (weak-box-ref w))) | |
| 49 (garbage-collect) | |
| 50 (Assert (not (weak-box-ref w)))) | |
| 51 | |
| 52 (garbage-collect) | |
| 53 | |
| 1636 | 54 ;; tests for ephemerons |
| 890 | 55 (let* ((p (cons 3 4)) |
| 56 (finalized-p nil) | |
| 57 (eph1 (make-ephemeron (cons 1 2) p | |
| 58 '(lambda (value) | |
| 59 (setq finalized-p t)))) | |
| 60 (eph2 (make-ephemeron p p))) | |
| 61 (Assert (eq p (ephemeron-ref (make-ephemeron (cons 1 2) p)))) | |
| 62 (Assert (ephemeron-p (make-ephemeron (cons 1 2) p))) | |
| 63 | |
| 64 (garbage-collect) | |
| 65 (garbage-collect) ; ensure the post-gc hook runs | |
| 66 | |
| 67 (Assert finalized-p) | |
| 68 (Assert (not (ephemeron-ref eph1))) | |
| 69 | |
| 70 (garbage-collect) | |
| 71 | |
| 72 (Assert (eq p (ephemeron-ref eph2)))) | |
| 73 | |
| 1636 | 74 (garbage-collect) |
| 75 | |
| 76 ;; tests for simple weak-lists | |
| 77 (let* ((a (cons 23 42)) | |
| 78 (b (cons 42 65)) | |
| 79 (testlist (list a b)) | |
| 80 (weaklist1 (make-weak-list 'simple)) | |
| 81 (weaklist2 (make-weak-list 'simple)) | |
| 82 (weaklist3 (make-weak-list 'simple)) | |
| 83 (weaklist4 (make-weak-list 'simple))) | |
| 84 (set-weak-list-list weaklist1 testlist) | |
| 85 (set-weak-list-list weaklist2 (list (cons 1 2) a b)) | |
| 86 (set-weak-list-list weaklist3 (list a (cons 1 2) b)) | |
| 87 (set-weak-list-list weaklist4 (list a b (cons 1 2))) | |
| 88 (Assert (weak-list-p weaklist1)) | |
| 89 (Assert (eq (weak-list-type weaklist1) 'simple)) | |
| 90 (Assert (weak-list-p weaklist2)) | |
| 91 (Assert (eq (weak-list-type weaklist2) 'simple)) | |
| 92 (Assert (weak-list-p weaklist3)) | |
| 93 (Assert (eq (weak-list-type weaklist3) 'simple)) | |
| 94 (Assert (weak-list-p weaklist4)) | |
| 95 (Assert (eq (weak-list-type weaklist4) 'simple)) | |
| 96 | |
| 97 (garbage-collect) | |
| 98 | |
| 99 (Assert (eq (weak-list-list weaklist1) testlist)) | |
| 100 (Assert (equal (weak-list-list weaklist2) testlist)) | |
| 101 (Assert (equal (weak-list-list weaklist3) testlist)) | |
| 102 (Assert (equal (weak-list-list weaklist4) testlist))) | |
| 103 | |
| 104 (garbage-collect) | |
| 105 | |
| 106 ;; tests for assoc weak-lists | |
| 107 (let* ((a (cons 23 42)) | |
| 108 (b (cons a a)) | |
| 109 (testlist (list b b)) | |
| 110 (weaklist1 (make-weak-list 'assoc)) | |
| 111 (weaklist2 (make-weak-list 'assoc)) | |
| 112 (weaklist3 (make-weak-list 'assoc)) | |
| 113 (weaklist4 (make-weak-list 'assoc))) | |
| 114 (set-weak-list-list weaklist1 testlist) | |
| 115 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 116 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 117 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 118 (Assert (weak-list-p weaklist1)) | |
| 119 (Assert (eq (weak-list-type weaklist1) 'assoc)) | |
| 120 (Assert (weak-list-p weaklist2)) | |
| 121 (Assert (eq (weak-list-type weaklist2) 'assoc)) | |
| 122 (Assert (weak-list-p weaklist3)) | |
| 123 (Assert (eq (weak-list-type weaklist3) 'assoc)) | |
| 124 (Assert (weak-list-p weaklist4)) | |
| 125 (Assert (eq (weak-list-type weaklist4) 'assoc)) | |
| 126 | |
| 127 (garbage-collect) | |
| 128 | |
| 129 (Assert (eq (weak-list-list weaklist1) testlist)) | |
| 130 (Assert (equal (weak-list-list weaklist2) testlist)) | |
| 131 (Assert (equal (weak-list-list weaklist3) testlist)) | |
| 132 (Assert (equal (weak-list-list weaklist4) testlist))) | |
| 133 | |
| 134 (garbage-collect) | |
| 135 | |
| 136 ;; tests for key-assoc weak-lists | |
| 137 (let* ((a (cons 23 42)) | |
| 138 (b (cons a a)) | |
| 139 (testlist (list b b)) | |
| 140 (weaklist1 (make-weak-list 'key-assoc)) | |
| 141 (weaklist2 (make-weak-list 'key-assoc)) | |
| 142 (weaklist3 (make-weak-list 'key-assoc)) | |
| 143 (weaklist4 (make-weak-list 'key-assoc))) | |
| 144 (set-weak-list-list weaklist1 testlist) | |
| 145 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 146 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 147 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 148 (Assert (weak-list-p weaklist1)) | |
| 149 (Assert (eq (weak-list-type weaklist1) 'key-assoc)) | |
| 150 (Assert (weak-list-p weaklist2)) | |
| 151 (Assert (eq (weak-list-type weaklist2) 'key-assoc)) | |
| 152 (Assert (weak-list-p weaklist3)) | |
| 153 (Assert (eq (weak-list-type weaklist3) 'key-assoc)) | |
| 154 (Assert (weak-list-p weaklist4)) | |
| 155 (Assert (eq (weak-list-type weaklist4) 'key-assoc)) | |
| 156 | |
| 157 (garbage-collect) | |
| 158 | |
| 159 (Assert (eq (weak-list-list weaklist1) testlist)) | |
| 160 (Assert (equal (weak-list-list weaklist2) testlist)) | |
| 161 (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) | |
| 162 (Assert (equal (weak-list-list weaklist4) testlist))) | |
| 163 | |
| 164 (garbage-collect) | |
| 165 | |
| 166 ;; tests for value-assoc weak-lists | |
| 167 (let* ((a (cons 23 42)) | |
| 168 (b (cons a a)) | |
| 169 (testlist (list b b)) | |
| 170 (weaklist1 (make-weak-list 'value-assoc)) | |
| 171 (weaklist2 (make-weak-list 'value-assoc)) | |
| 172 (weaklist3 (make-weak-list 'value-assoc)) | |
| 173 (weaklist4 (make-weak-list 'value-assoc))) | |
| 174 (set-weak-list-list weaklist1 testlist) | |
| 175 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 176 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 177 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 178 (Assert (weak-list-p weaklist1)) | |
| 179 (Assert (eq (weak-list-type weaklist1) 'value-assoc)) | |
| 180 (Assert (weak-list-p weaklist2)) | |
| 181 (Assert (eq (weak-list-type weaklist2) 'value-assoc)) | |
| 182 (Assert (weak-list-p weaklist3)) | |
| 183 (Assert (eq (weak-list-type weaklist3) 'value-assoc)) | |
| 184 (Assert (weak-list-p weaklist4)) | |
| 185 (Assert (eq (weak-list-type weaklist4) 'value-assoc)) | |
| 186 | |
| 187 (garbage-collect) | |
| 188 | |
| 189 (Assert (eq (weak-list-list weaklist1) testlist)) | |
| 190 (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) | |
| 191 (Assert (equal (weak-list-list weaklist3) testlist)) | |
| 192 (Assert (equal (weak-list-list weaklist4) testlist))) | |
| 193 | |
| 194 (garbage-collect) | |
| 195 | |
| 196 ;; tests for full-assoc weak-lists | |
| 197 (let* ((a (cons 23 42)) | |
| 198 (b (cons a a)) | |
| 199 (testlist (list b b)) | |
| 200 (weaklist1 (make-weak-list 'full-assoc)) | |
| 201 (weaklist2 (make-weak-list 'full-assoc)) | |
| 202 (weaklist3 (make-weak-list 'full-assoc)) | |
| 203 (weaklist4 (make-weak-list 'full-assoc))) | |
| 204 (set-weak-list-list weaklist1 testlist) | |
| 205 (set-weak-list-list weaklist2 (list b (cons (cons 1 2) a) b)) | |
| 206 (set-weak-list-list weaklist3 (list b (cons a (cons 1 2)) b)) | |
| 207 (set-weak-list-list weaklist4 (list b (cons (cons 1 2) (cons 3 4)) b)) | |
| 208 (Assert (weak-list-p weaklist1)) | |
| 209 (Assert (eq (weak-list-type weaklist1) 'full-assoc)) | |
| 210 (Assert (weak-list-p weaklist2)) | |
| 211 (Assert (eq (weak-list-type weaklist2) 'full-assoc)) | |
| 212 (Assert (weak-list-p weaklist3)) | |
| 213 (Assert (eq (weak-list-type weaklist3) 'full-assoc)) | |
| 214 (Assert (weak-list-p weaklist4)) | |
| 215 (Assert (eq (weak-list-type weaklist4) 'full-assoc)) | |
| 216 | |
| 217 (garbage-collect) | |
| 218 | |
| 219 (Assert (eq (weak-list-list weaklist1) testlist)) | |
| 220 (Assert (equal (weak-list-list weaklist2) (list b (cons (cons 1 2) a) b))) | |
| 221 (Assert (equal (weak-list-list weaklist3) (list b (cons a (cons 1 2)) b))) | |
| 222 (Assert (equal (weak-list-list weaklist4) testlist))) | |
| 223 | |
| 224 (garbage-collect) | |
|
1773
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
225 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
226 ;; 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
|
227 ;; 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
|
228 ;; 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
|
229 ;; specification |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
230 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
231 (let* ((inner_cons (cons 1 2)) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
232 (weak1 (make-ephemeron inner_cons |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
233 (make-ephemeron inner_cons |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
234 (cons 1 2) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
235 '(lambda (v) t)) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
236 '(lambda (v) t)))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
237 (Assert (ephemeron-ref (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
238 (garbage-collect) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
239 ;; assure the inner ephis are still there |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
240 (Assert (ephemeron-ref (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
241 ;; 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
|
242 (setq inner_cons (cons 3 4)) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
243 (garbage-collect) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
244 (Assert (not (ephemeron-ref weak1))) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
245 ) |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
246 |
|
aa0db78e67c4
[xemacs-hg @ 2003-11-01 14:54:53 by kaltenbach]
kaltenbach
parents:
1758
diff
changeset
|
247 (garbage-collect) |