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

tests

darcs-hash:d43a05aa8b9306934682afc5f5b8d58d3d253795
parent 5adac01b
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
(defpackage :submarine-system
(:use :common-lisp :asdf))
(in-package :submarine-system)
(defsystem :submarine-tests
:depends-on (:postmodern :submarine :fiveam)
:serial t
:components
((:file "submarine-tests")))
;;; Copyright (C) 2007
;;; Ryszard Szopa <ryszard.szopa@gmail.com> &
;;; Streamtech http://streamtech.nl/
;;;
;;; This software is provided 'as-is', without any express or implied
;;; warranty. In no event will the authors be held liable for any
;;; damages arising from the use of this software.
;;;
;;; Permission is granted to anyone to use this software for any
;;; purpose, including commercial applications, and to alter it and
;;; redistribute it freely, subject to the following restrictions:
;;;
;;; 1. The origin of this software must not be misrepresented; you must
;;; not claim that you wrote the original software. If you use this
;;; software in a product, an acknowledgment in the product
;;; documentation would be appreciated but is not required.
;;;
;;; 2. Altered source versions must be plainly marked as such, and must
;;; 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
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
(in-package :asdf)
(defpackage :submarine-tests
(:use :cl :submarine :fiveam))
(in-package :submarine-tests)
(asdf:operate 'asdf:load-op :submarine)
(pomo:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "CREATE DATABASE \"submarine-test\";"))
(defmacro defdao-example (name supers &body body)
"Wrapper macro for defining a class inheriting from DAO with the
metaclass set to HTML and the right connection-spec."
`(defclass ,name (dao ,@supers)
,@body
(: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
:initarg :affiliation)))
(defdao-example club ()
((name :initarg :name :accessor club-name :type string)))
(def-many-to-many person club)
;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
:initform nil
:initarg :affiliation)))
(defdao-example club ()
((name :initarg :name :accessor club-name :type string)))
(def-many-to-many person club)))
(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:with-connection ( "test" "richard" "dupa" "localhost")
(postmodern:execute "DROP DATABASE \"submarine-test\";"))
;;; Copyright (C) 2007
;;; Ryszard Szopa <ryszard.szopa@gmail.com> &
;;; Streamtech http://streamtech.nl/
;;;
;;; This software is provided 'as-is', without any express or implied
;;; warranty. In no event will the authors be held liable for any
;;; damages arising from the use of this software.
;;;
;;; Permission is granted to anyone to use this software for any
;;; purpose, including commercial applications, and to alter it and
;;; redistribute it freely, subject to the following restrictions:
;;;
;;; 1. The origin of this software must not be misrepresented; you must
;;; not claim that you wrote the original software. If you use this
;;; software in a product, an acknowledgment in the product
;;; documentation would be appreciated but is not required.
;;;
;;; 2. Altered source versions must be plainly marked as such, and must
;;; 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
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