Commit ebb93a08 authored by ryszard.szopa's avatar ryszard.szopa
Browse files

new, sensible tests

darcs-hash:a8db9177fac2b5ad373b5f6bf2b6ca1771cc2c07
parent 85c03036
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
(in-package :asdf)
(in-package :asdf)
(defpackage :submarine-tests
(:use :cl :submarine :fiveam))
(in-package :submarine-tests)
(asdf:operate 'asdf:load-op :submarine)
(def-fixture db-fixture ()
(progn (set-up)
(unwind-protect (&body)
(clean))))
(defmacro db-test (name &body body)
`(test ,(append (fiveam::ensure-list name) '(:fixture db-fixture)) ,@body))
(postmodern:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "CREATE DATABASE \"submarine-test\";"))
(defun set-up ()
(postmodern:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "CREATE DATABASE \"submarine-test\";")))
(defun clean ()
(pomo:clear-connection-pool)
(sleep .05)
(pomo:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "DROP DATABASE \"submarine-test\";")))
(defun sql (string)
(with-connection ("submarine-test" "richard" "dupa" "localhost")
(pomo:query string)))
(defmacro defdao-example (name supers &body body)
"Wrapper macro for defining a class inheriting from DAO with the
......@@ -19,121 +37,47 @@ metaclass set to HTML and the right connection-spec."
(:connection-spec "submarine-test" "richard" "dupa" "localhost")
(:metaclass db-class)))
(defdao-example affiliation ()
((name :type string :initarg :name :accessor affiliation-name)))
(defdao-example person ()
((name :initarg :name :accessor person-name :type string)
(affiliation :accessor person-affiliation :type affiliation
:initform nil
:foreign t
:initarg :affiliation)))
(defdao-example club ()
((name :initarg :name :accessor club-name :type string)))
(def-many-to-many person club ("submarine-test" "richard" "dupa" "localhost"))
;this may at first complain
;seaying that the class person
;doesn't exist. Run this again
;to fix it.
(defun clean-database ()
(mapc #'delete-dao (select-dao 'person))
(mapc #'delete-dao (select-dao 'affiliation))
(mapc #'delete-dao (select-dao 'club)))
(def-suite submarine :description "Submarine tests.")
(in-suite submarine)
(test class-redefinition
(finishes
(defdao-example affiliation ()
((name :type string :initarg :name :accessor affiliation-name)))
(defdao-example person ()
((name :initarg :name :accessor person-name :type string)
(affiliation :accessor person-affiliation :type affiliation
:foreign t
:initform nil
:initarg :affiliation)))
(defdao-example club ()
((name :initarg :name :accessor club-name :type string)))
(def-many-to-many person club ("submarine-test" "richard" "dupa" "localhost"))))
(test save-dao
(let ((democ (save-dao (make-instance 'affiliation :name "Democrats")))
(repub (save-dao (make-instance 'affiliation :name "Republicans"))))
(save-dao (make-instance 'club :name "Lion's"))
(save-dao (make-instance 'club :name "Rotary"))
(save-dao (make-instance 'club :name "The Lodge"))
(save-dao (make-instance 'person :name "John" :affiliation democ))
(save-dao (make-instance 'person :name "Roger" :affiliation democ))
(save-dao (make-instance 'person :name "Henry" :affiliation repub))
(is (= 3 (length (select-dao 'person))))
(is (= 3 (length (select-dao 'person))))
(is (= 2 (length (select-dao 'affiliation))))
(is (= 3 (length (select-dao 'club))))
(clean-database)))
(test relate
(let* ((lions (save-dao (make-instance 'club :name "Lion's")))
(rotary (save-dao (make-instance 'club :name "Rotary")))
(lodge (save-dao (make-instance 'club :name "The Lodge")))
(democ (save-dao (make-instance 'affiliation :name "Democrats")))
(repub (save-dao (make-instance 'affiliation :name "Republicans")))
(john (save-dao (make-instance 'person :name "John" :affiliation democ)))
(roger (save-dao (make-instance 'person :name "Roger" :affiliation democ)))
(henry (save-dao (make-instance 'person :name "Henry" :affiliation repub))))
(loop :for person :in (list john roger henry)
:do (relate person lodge))
(relate john lions)
(relate roger rotary)
(relate henry lions)
(relate henry rotary)
(is (= 3 (length (person lodge))))
(clean-database)))
(test get-all
(mapc #'delete-dao (select-dao 'person))
(is (= 0 (length (select-dao 'person))))
(let ((democ (save-dao (make-instance 'affiliation :name "Democrats")))
(repub (save-dao (make-instance 'affiliation :name "Republicans"))))
(save-dao (make-instance 'person :name "John" :affiliation democ))
(save-dao (make-instance 'person :name "Roger" :affiliation democ))
(save-dao (make-instance 'person :name "Henry" :affiliation repub)))
(is (= 2 (length (get-all 'person (car (select-dao 'affiliation (:= name "Democrats")))))))
(is (= 1 (length (get-all 'person (car (select-dao 'affiliation (:= name "Republicans")))))))
(clean-database))
(test make-instance-with-nonexistant-id
(signals dao-nonexistent-id (make-instance 'person :id 1234)))
(test make-instance
(string= "foo" (club-name (make-instance 'club :id (get-id (save-dao (make-instance 'club :name "foo")))))))
(run!)
(sleep 3)
(pomo:clear-connection-pool)
(pomo:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "DROP DATABASE \"submarine-test\";"))
(defmacro defmany (x y)
`(def-many-to-many ,x ,y ("submarine-test" "richard" "dupa" "localhost")))
#.(def-suite submarine-tests)
(in-suite submarine-tests)
(db-test class-connection
(defdao-example class-connection ()
())
(finishes (with-class-connection ((find-class 'class-connection))
(pomo::query "SELECT 1;"))))
(db-test dao-definition
(finishes
(defdao-example foo ()
((foo :type integer)))))
(db-test dao-redefinition
(finishes
(defdao-example foo ()
((foo :type integer)))
(defdao-example foo ()
((foo :type integer)))))
(db-test (many-to-many-definition :depends-on dao-definition)
(finishes
(defdao-example foo ()
((foo :type integer)))
(defdao-example bar ()
((bar :type integer)))
(defmany foo bar)))
(db-test many-to-many-redefinition
(finishes
(defdao-example foo ()
((foo :type integer)))
(defdao-example bar ()
((bar :type integer)))
(defmany foo bar)
(defmany foo bar)))
;;; Copyright (C) 2007
;;; Ryszard Szopa <ryszard.szopa@gmail.com> &
......@@ -156,4 +100,5 @@ metaclass set to HTML and the right connection-spec."
;;; not be misrepresented as being the original software.
;;;
;;; 3. This notice may not be removed or altered from any source
;;; distribution.
\ No newline at end of file
;;; distribution.
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment