Author: achiumenti Date: Thu Sep 18 09:32:48 2008 New Revision: 97
Modified: trunk/main/claw-demo/test/backend/tests.lisp Log: several bugfixes and enhancements
Modified: trunk/main/claw-demo/test/backend/tests.lisp ============================================================================== --- trunk/main/claw-demo/test/backend/tests.lisp (original) +++ trunk/main/claw-demo/test/backend/tests.lisp Thu Sep 18 09:32:48 2008 @@ -29,198 +29,199 @@
(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)))) + (lift:deftestsuite claw-demo-backend-testsuite () + () + (:setup (progn (setf *claw-demo-db* + (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))))