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@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@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@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@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@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@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))))