[claw-cvs] r74 - trunk/main/claw-demo/test/backend
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Tue Aug 26 11:03:41 UTC 2008
Author: achiumenti
Date: Tue Aug 26 07:03:39 2008
New Revision: 74
Added:
trunk/main/claw-demo/test/backend/
trunk/main/claw-demo/test/backend/tests.lisp
Log:
CLAW demo tests
Added: trunk/main/claw-demo/test/backend/tests.lisp
==============================================================================
--- (empty file)
+++ trunk/main/claw-demo/test/backend/tests.lisp Tue Aug 26 07:03:39 2008
@@ -0,0 +1,226 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: src/setup.lisp $
+
+;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :claw-demo-backend)
+
+(lift:deftestsuite claw-demo-backend-testsuite ()
+ ()
+ (:setup (let ((*default-database*
+ (db-connect '("127.0.0.1" "claw-demo-test" "claw-demo" "demo"))))
+ (drop-claw-demo-tables)
+ (create-claw-demo-tables)))
+ (:teardown (db-disconnect)))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ simple-insert
+ (let ((role (make-instance 'role :name "admin" :description "Administration role")))
+ (update-db-item role)
+ (lift:ensure (table-id role))
+ (setf role (first (find-vo 'role
+ :where (sql-operation 'like
+ (sql-expression-upper :attribute (slot-column-name 'role 'name))
+ (string-upcase "admiN")))))
+ (lift:ensure role)
+ (lift:ensure (= (table-version role) 0))
+ (setf (role-description role) "Administration")
+ (update-db-item role)
+ (setf role (first (find-vo 'role
+ :where (sql-operation 'like
+ (sql-expression-upper :attribute (slot-column-name 'role 'name))
+ (string-upcase "admiN")))))
+ (lift:ensure (> (table-version role) 0))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ simple-empty-table
+ (let* ((name "simple-empty-table")
+ (role (make-instance 'role :name name)))
+ (update-db-item role)
+ (lift:ensure (find-vo 'role) :report "Role table is empty")
+ (delete-class-records 'role)
+ (let ((rs (find-vo 'role :refresh t)))
+ (lift:ensure-null rs :report "Role table is NOT empty ~a" :arguments ((length rs))))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ user-roles-relation
+ (let ((role1 (make-instance 'role :name "role1"))
+ (role2 (make-instance 'role :name "role2"))
+ (user (make-instance 'user :firstname "Jhon"
+ :surname "Doe"
+ :username "jd"
+ :password "pwd"
+ :email "jd at new.com")))
+ (delete-class-records 'user-role)
+ (delete-class-records 'user)
+ (delete-class-records 'role)
+ (update-db-item role1)
+ (update-db-item role2)
+ (lift:ensure (= (length (find-vo 'role)) 2) :report "Role table size is not 2")
+ (setf (user-roles user) (list role1 role2)) ;here we add two roles to the user
+ (update-db-item user)
+ (multiple-value-bind (records count)
+ (find-vo 'user)
+ (lift:ensure (= count 1))
+ (lift:ensure (= (length (user-roles (first records))) 2)))
+ (setf (user-username user) "changed") ;here we ensure that the user doesn't loose roles after a change
+ (update-db-item user)
+ (multiple-value-bind (records count)
+ (find-vo 'user)
+ (lift:ensure (= count 1))
+ (lift:ensure (= (length (user-roles (first records))) 2)))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ user-roles-fk
+ (let ((role1 (make-instance 'role :name "roleA"))
+ (role2 (make-instance 'role :name "roleB"))
+ (user (make-instance 'user :firstname "Jhon"
+ :surname "Doe"
+ :username "jd"
+ :password "pwd"
+ :email "jd at new.com")))
+ (delete-class-records 'user)
+ (delete-class-records 'role)
+ (update-db-item role1)
+ (update-db-item role2)
+ (setf (user-roles user) (list role1 role2))
+ (update-db-item user)
+ (delete-class-records 'role
+ :where (sql-operation '=
+ (sql-expression :attribute (slot-column-name 'role 'name))
+ "roleA"))
+ (setf user (reload-db-item user))
+ (lift:ensure (= (length (user-roles user)) 1)
+ :report "Expected 1 role for test user, found ~d"
+ :arguments ((length (user-roles user))))
+ (lift:ensure (= (length (role-users role2)) 1)
+ :report "Expected 1 user for test role \"roleB\", found ~d"
+ :arguments ((length (role-users role2))))
+ (delete-class-records 'user)
+ (lift:ensure (null (find-vo 'user))
+ :report "Users table is not empty")
+ (setf role2 (reload-db-item role2))
+ (let ((role-users (role-users role2)))
+ (lift:ensure (null role-users)
+ :report "Role \"roleB\" still contains references to ~d user\(s)"
+ :arguments ((length role-users))))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ cusromer-creation
+ (let ((customer (make-instance 'customer
+ :name1 "Andrea"
+ :name2 "Chiumenti"
+ :email "a.chiumenti at new.com"
+ :phone1 "+393900001"
+ :phone2 "+393900002"
+ :phone3 "+393900003"
+ :fax "+393900010"
+ :vat "9999999999"
+ :code1 "code1"
+ :code1 "code2"
+ :code1 "code3"
+ :code1 "code4"
+ :addresses (list (make-instance 'customer-address
+ :address "St. Foo, 1"
+ :city "Milano"
+ :zip "20100"
+ :state "MI"
+ :country "ITALY")
+ (make-instance 'customer-address
+ :address-type 1
+ :address "St. Bar, 1"
+ :zip "20100"
+ :city "Milano"
+ :state "MI"
+ :country "ITALY")))))
+ (delete-class-records 'customer)
+ (update-db-item customer)
+ (let ((addresses (find-vo 'customer-address
+ :where (sql-operation '=
+ (sql-expression :attribute (slot-column-name 'customer-address 'customer-id))
+ (table-id customer)))))
+ (lift:ensure (= (length addresses)
+ 2)
+ :report "Expected 2 customer address records, found ~d"
+ :arguments ((length addresses)))
+ ;;testing referential integrity
+ (delete-db-item customer)
+ (let ((addresses (find-vo 'customer-address)))
+ (lift:ensure-null addresses
+ :report "Table cutomer-addresses expected to be empty. Found ~d records."
+ :arguments ((length addresses)))))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ find-user-by-name
+ (let ((admin-role (make-instance 'role :name "administrator"))
+ (user-role (make-instance 'role :name "user")))
+ (update-db-item admin-role)
+ (update-db-item user-role)
+ (update-db-item (make-instance 'user :firstname "Andrea"
+ :surname "Chiumenti"
+ :username "admin"
+ :password "admin"
+ :email "admin at new.com"
+ :roles (list admin-role user-role)))
+ (lift:ensure (find-user-by-name "admin"))))
+
+(lift:addtest (claw-demo-backend-testsuite)
+ like-operation
+ (let ((admin-role (make-instance 'role :name "administrator"))
+ (user-role (make-instance 'role :name "user")))
+ (update-db-item admin-role)
+ (update-db-item user-role)
+ (update-db-item (make-instance 'user :firstname "Andrea"
+ :surname "Chiumenti"
+ :username "admin\\&1"
+ :password "admin"
+ :email "admin at new.com"
+ :roles (list admin-role user-role)))
+ (lift:ensure (find-vo 'user :where (like-operation 'username "*n\\&1")))
+ (lift:ensure-null (find-vo 'user :where (like-operation 'username "*n\\&")))))
+
+
+(lift:addtest (claw-demo-backend-testsuite)
+ find-customers
+ (let ((customer (make-instance 'customer
+ :name1 "Andrea"
+ :name2 "Chiumenti"
+ :email "a.chiumenti at new.com"
+ :phone1 "+393900001"
+ :phone2 "+393900002"
+ :phone3 "+393900003"
+ :fax "+393900010"
+ :vat "9999999999"
+ :code1 "code1"
+ :code1 "code2"
+ :code1 "code3"
+ :code1 "code4")))
+ (delete-class-records 'customer)
+ (update-db-item customer)
+ (lift:ensure (find-customers :name1 "andrea"))
+ (lift:ensure (find-customers :name1 "andrea" :name2 "ch*"))
+ (lift:ensure (find-customers))))
More information about the Claw-cvs
mailing list