tests/test-pool.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:    test-pool.lisp
   6 ;;;; Purpose: Tests for connection pools
   7 ;;;; Author:  Ryan Davis
   8 ;;;; Created: June 27 2011
   9 ;;;;
  10 ;;;; This file, part of CLSQL, is Copyright (c) 2004-2010 by Kevin M. Rosenberg
  11 ;;;;
  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)
  17
  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)
  25     db))
  26 (defmethod clsql-sys::database-name-from-spec (connection-spec (database-type (eql :dummy)))
  27   "dummy")
  28 (defmethod clsql-sys::database-acquire-from-conn-pool ((db dummy-database)) T)
  29
  30 (setq *rt-pool*
  31   '(
  32     (deftest :pool/acquire
  33      (let ((pool (clsql-sys::find-or-create-connection-pool nil :dummy))
  34            dbx res)
  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)))
  39
  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)))
  44            (setf dbx db))
  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)))
  49          )
  50        (nreverse res))
  51      (0 0 T 1 0 1 1 T)
  52      )
  53
  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)
  58                       dbs)
  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)
  63                           dbs))
  64                   (list (length (clsql-sys::all-connections pool))
  65                         (progn
  66                           (dolist (db dbs) (clsql-sys:disconnect :database db))
  67                           (length (clsql-sys::free-connections pool))
  68                           )))))
  69          (append
  70           (run 5 10)
  71           (run nil 10))))
  72      (10 5 10 10)
  73      )
  74
  75
  76
  77     (deftest :pool/find-or-create-connection-pool
  78      (let ((p (clsql-sys::find-or-create-connection-pool nil :dummy)))
  79        (values (null p)
  80                (eq p (clsql-sys::find-or-create-connection-pool nil :dummy))
  81                (eq p (clsql-sys::find-or-create-connection-pool :spec :dummy))))
  82      nil T nil)
  83     ))