GopherProxy

	ttests.lisp - clic - Clic is an command line interactive client for gopher writ…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	ttests.lisp (3562B)
	---
	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 ;;; <[email protected]> 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 (pushnew 'hashtables.weak-value.1 rt::expected-failures)
	49
	50 (deftest hashtables.weak-key.1
	51 (let ((ht (make-weak-hash-table :weakness :key)))
	52 (values (hash-table-p ht)
	53 (hash-table-weakness ht)))
	54 t :key)
	55
	56 (deftest hashtables.weak-key.2
	57 (let ((ht (make-weak-hash-table :weakness :key :test 'eq)))
	58 (values (hash-table-p ht)
	59 (hash-table-weakness ht)))
	60 t :key)
	61
	62 (deftest hashtables.weak-value.1
	63 (let ((ht (make-weak-hash-table :weakness :value)))
	64 (values (hash-table-p ht)
	65 (hash-table-weakness ht)))
	66 t :value)
	67
	68 (deftest hashtables.not-weak.1
	69 (hash-table-weakness (make-hash-table))
	70 nil)
	71
	72 ;;;; Finalizers
	73 ;;;
	74 ;;; These tests are, of course, not very reliable.
	75
	76 (defun dummy (x)
	77 (declare (ignore x))
	78 nil)
	79
	80 (defun test-finalizers-aux (count extra-action)
	81 (let ((cons (list 0))
	82 (obj (string (gensym))))
	83 (dotimes (i count)
	84 (finalize obj (lambda () (incf (car cons)))))
	85 (when extra-action
	86 (cancel-finalization obj)
	87 (when (eq extra-action :add-again)
	88 (dotimes (i count)
	89 (finalize obj (lambda () (incf (car cons)))))))
	90 (setq obj (gensym))
	91 (setq obj (dummy obj))
	92 cons))
	93
	94 (defvar result)
	95
	96 ;;; I don't really understand this, but it seems to work, and stems
	97 ;;; from the observation that typing the code in sequence at the REPL
	98 ;;; achieves the desired result. Superstition at its best.
	99 (defmacro voodoo (string)
	100 `(funcall
	101 (compile nil `(lambda ()
	102 (eval (let ((package (find-package :tg-tests)))
	103 (read-from-string ,,string)))))))
	104
	105 (defun test-finalizers (count &optional remove)
	106 (gc :full t)
	107 (voodoo (format nil "(setq result (test-finalizers-aux ~S ~S))"
	108 count remove))
	109 (voodoo "(gc :full t)")
	110 ;; Normally done by a background thread every 0.3 sec:
	111 #+openmcl (ccl::drain-termination-queue)
	112 ;; (an alternative is to sleep a bit)
	113 (voodoo "(car result)"))
	114
	115 (deftest finalizers.1
	116 (test-finalizers 1)
	117 1)
	118
	119 (deftest finalizers.2
	120 (test-finalizers 1 t)
	121 0)
	122
	123 (deftest finalizers.3
	124 (test-finalizers 5)
	125 5)
	126
	127 (deftest finalizers.4
	128 (test-finalizers 5 t)
	129 0)
	130
	131 (deftest finalizers.5
	132 (test-finalizers 5 :add-again)
	133 5)