1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: test-pool.lisp
6 ;;;; Purpose: Tests for connection pools
7 ;;;; Author: Ryan Davis
8 ;;;; Created: June 27 2011
10 ;;;; This file, part of CLSQL, is Copyright (c) 2004-2010 by Kevin M. Rosenberg
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
16 (in-package #:clsql-tests)
18 ;; setup a dummy database for the pool to use
19 (pushnew :dummy clsql-sys:*loaded-database-types*)
20 (defclass dummy-database (clsql-sys:database) ()
21 (:default-initargs :database-type :dummy))
22 (defmethod clsql-sys:database-connect (connection-spec (database-type (eql :dummy)))
23 (let ((db (make-instance 'dummy-database :connection-spec connection-spec)))
24 (setf (slot-value db 'clsql-sys::state) :open)
26 (defmethod clsql-sys::database-name-from-spec (connection-spec (database-type (eql :dummy)))
28 (defmethod clsql-sys::database-acquire-from-conn-pool ((db dummy-database)) T)
32 (deftest :pool/acquire
33 (let ((pool (clsql-sys::find-or-create-connection-pool nil :dummy))
35 (clsql-sys::clear-conn-pool pool)
36 (flet ((test-result (x) (push x res)))
37 (test-result (length (clsql-sys::all-connections pool)))
38 (test-result (length (clsql-sys::free-connections pool)))
40 (clsql-sys:with-database (db nil :database-type :dummy :pool T)
41 (test-result (not (null db)))
42 (test-result (length (clsql-sys::all-connections pool)))
43 (test-result (length (clsql-sys::free-connections pool)))
45 (test-result (length (clsql-sys::all-connections pool)))
46 (test-result (length (clsql-sys::free-connections pool)))
47 (clsql-sys:with-database (db nil :database-type :dummy :pool T)
48 (test-result (eq db dbx)))
54 (deftest :pool/max-free-connections
55 (let ((pool (clsql-sys::find-or-create-connection-pool nil :dummy)))
56 (flet ((run (max-free dbs-to-release)
57 (let ((clsql-sys:*db-pool-max-free-connections* max-free)
59 (clsql-sys::clear-conn-pool pool)
60 (dotimes (i dbs-to-release dbs)
61 (push (clsql-sys:connect nil :database-type :dummy
62 :pool T :if-exists :new)
64 (list (length (clsql-sys::all-connections pool))
66 (dolist (db dbs) (clsql-sys:disconnect :database db))
67 (length (clsql-sys::free-connections pool))
77 (deftest :pool/find-or-create-connection-pool
78 (let ((p (clsql-sys::find-or-create-connection-pool nil :dummy)))
80 (eq p (clsql-sys::find-or-create-connection-pool nil :dummy))
81 (eq p (clsql-sys::find-or-create-connection-pool :spec :dummy))))