tests.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
tests.lisp (3901B)
---
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; tests.lisp --- trivial-garbage tests.
4 ;;;
5 ;;; This software is placed in the public domain by Luis Oliveira
6 ;;; <loliveira@common-lisp.net> and is provided with absolutely no
7 ;;; warranty.
8
9 (defpackage #:trivial-garbage-tests
10 (:use #:cl #:trivial-garbage #:regression-test)
11 (:nicknames #:tg-tests)
12 (:export #:run))
13
14 (in-package #:trivial-garbage-tests)
15
16 (defun run ()
17 (let ((*package* (find-package :trivial-garbage-tests)))
18 (do-tests)
19 (null (set-difference (regression-test:pending-tests)
20 rtest::*expected-failures*))))
21
22 ;;;; Weak Pointers
23
24 (deftest pointers.1
25 (weak-pointer-p (make-weak-pointer 42))
26 t)
27
28 (deftest pointers.2
29 (weak-pointer-value (make-weak-pointer 42))
30 42)
31
32 ;;;; Weak Hashtables
33
34 (eval-when (:compile-toplevel :load-toplevel :execute)
35 (defun sbcl-without-weak-hash-tables-p ()
36 (if (and (find :sbcl *features*)
37 (not (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")))
38 '(:and)
39 '(:or))))
40
41 #+(or corman scl #.(tg-tests::sbcl-without-weak-hash-tables-p))
42 (progn
43 (pushnew 'hashtables.weak-key.1 rt::*expected-failures*)
44 (pushnew 'hashtables.weak-key.2 rt::*expected-failures*)
45 (pushnew 'hashtables.weak-value.1 rt::*expected-failures*))
46
47 #+clasp
48 (progn
49 (pushnew 'pointers.1 rt::*expected-failures*)
50 (pushnew 'pointers.2 rt::*expected-failures*)
51 (pushnew 'hashtables.weak-value.1 rt::*expected-failures*))
52
53 (deftest hashtables.weak-key.1
54 (let ((ht (make-weak-hash-table :weakness :key)))
55 (values (hash-table-p ht)
56 (hash-table-weakness ht)))
57 t :key)
58
59 (deftest hashtables.weak-key.2
60 (let ((ht (make-weak-hash-table :weakness :key :test 'eq)))
61 (values (hash-table-p ht)
62 (hash-table-weakness ht)))
63 t :key)
64
65 (deftest hashtables.weak-value.1
66 (let ((ht (make-weak-hash-table :weakness :value)))
67 (values (hash-table-p ht)
68 (hash-table-weakness ht)))
69 t :value)
70
71 (deftest hashtables.not-weak.1
72 (hash-table-weakness (make-hash-table))
73 nil)
74
75 ;;;; Finalizers
76 ;;;
77 ;;; These tests are, of course, not very reliable.
78
79 (defun dummy (x)
80 (declare (ignore x))
81 nil)
82
83 (defun test-finalizers-aux (count extra-action)
84 (let* ((cons (list 0))
85 ;; lbd should not be defined in a lexical scope where obj is
86 ;; present to prevent closing over the variable on compilers
87 ;; which does not optimize away unused lexenv variables (i.e
88 ;; ecl's bytecmp).
89 (lbd (lambda () (incf (car cons))))
90 (obj (string (gensym))))
91 (dotimes (i count)
92 (finalize obj lbd))
93 (when extra-action
94 (cancel-finalization obj)
95 (when (eq extra-action :add-again)
96 (dotimes (i count)
97 (finalize obj lbd))))
98 (setq obj (gensym))
99 (setq obj (dummy obj))
100 cons))
101
102 (defvar *result*)
103
104 ;;; I don't really understand this, but it seems to work, and stems
105 ;;; from the observation that typing the code in sequence at the REPL
106 ;;; achieves the desired result. Superstition at its best.
107 (defmacro voodoo (string)
108 `(funcall
109 (compile nil `(lambda ()
110 (eval (let ((*package* (find-package :tg-tests)))
111 (read-from-string ,,string)))))))
112
113 (defun test-finalizers (count &optional remove)
114 (gc :full t)
115 (voodoo (format nil "(setq *result* (test-finalizers-aux ~S ~S))"
116 count remove))
117 (voodoo "(gc :full t)")
118 ;; Normally done by a background thread every 0.3 sec:
119 #+openmcl (ccl::drain-termination-queue)
120 ;; (an alternative is to sleep a bit)
121 (voodoo "(car *result*)"))
122
123 (deftest finalizers.1
124 (test-finalizers 1)
125 1)
126
127 (deftest finalizers.2
128 (test-finalizers 1 t)
129 0)
130
131 (deftest finalizers.3
132 (test-finalizers 5)
133 5)
134
135 (deftest finalizers.4
136 (test-finalizers 5 t)
137 0)
138
139 (deftest finalizers.5
140 (test-finalizers 5 :add-again)
141 5)