ttests.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP (HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/ (DIR) Log (DIR) Files (DIR) Refs (DIR) Tags (DIR) 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 ;;; <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 (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)