[claw-cvs] r97 - trunk/main/claw-demo/test/backend
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Thu Sep 18 13:32:49 UTC 2008
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 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))))
+ (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 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