X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=ed949879c440b32c3a5ffd5116845f929d994fb6;hb=69df048c1413aa55d9816ad4c7d6f32ae2d6c6cc;hp=f4268d7f32326713a81a4d14844057c238e43ec1;hpb=9f88a2a19d13afb9ab7f35ad1df522d00301b56d;p=clsql.git diff --git a/tests/test-init.lisp b/tests/test-init.lisp index f4268d7..ed94987 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -38,7 +38,7 @@ :initarg :height) (married :db-kind :base :accessor married :type boolean :initarg :married) - (birthday :type clsql-base:wall-time :initarg :birthday) + (birthday :type clsql:wall-time :initarg :birthday) (hobby :db-kind :virtual :initarg :hobby :initform nil))) (def-view-class employee (person) @@ -64,14 +64,14 @@ :accessor employee-email :type (string 100) :initarg :email) - (companyid + (ecompanyid :type integer :initarg :companyid) (company :accessor employee-company :db-kind :join :db-info (:join-class company - :home-key companyid + :home-key ecompanyid :foreign-key companyid :set nil)) (managerid @@ -89,7 +89,7 @@ :db-kind :join :db-info (:join-class employee-address :home-key emplid - :foreign-key emplid + :foreign-key aemplid :target-slot address :set t))) (:base-table employee)) @@ -123,10 +123,8 @@ :db-kind :join :db-info (:join-class employee :home-key (companyid groupid) - :foreign-key (companyid groupid) - :set t))) - (:base-table company)) - + :foreign-key (ecompanyid groupid) + :set t)))) (def-view-class address () ((addressid @@ -147,22 +145,23 @@ :type (string 30) :initarg :city) (postal-code - :column "zip" + :column zip :type integer :void-value 0 - :initarg :postal-code))) + :initarg :postal-code)) + (:base-table addr)) ;; many employees can reside at many addressess (def-view-class employee-address () - ((emplid :type integer - :initarg :emplid) - (addressid :type integer - :initarg :addressid) + ((aemplid :type integer :initarg :emplid) + (aaddressid :type integer :initarg :addressid) + (verified :type boolean :initarg :verified) (address :db-kind :join :db-info (:join-class address - :home-key addressid + :home-key aaddressid :foreign-key addressid - :retrieval :immediate)))) + :retrieval :immediate))) + (:base-table "ea_join")) (defun test-connect-to-database (db-type spec) (when (db-backend-has-create/destroy-db? db-type) @@ -218,7 +217,7 @@ (clsql:create-view-from-class 'address) (clsql:create-view-from-class 'employee-address)) - (let ((*update-records-on-make-instance* t)) + (let ((*db-auto-sync* t)) (setf company1 (make-instance 'company :presidentid 1 :companyid 1 @@ -229,7 +228,7 @@ :groupid 1 :married t :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Vladamir" :last-name "Lenin" :email "lenin@soviet.org" @@ -239,7 +238,7 @@ :groupid 1 :height (1+ (random 1.00)) :married t - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Josef" :last-name "Stalin" :email "stalin@soviet.org" @@ -250,7 +249,7 @@ :groupid 1 :height (1+ (random 1.00)) :married t - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Leon" :last-name "Trotsky" :email "trotsky@soviet.org" @@ -261,7 +260,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Nikita" :last-name "Kruschev" :email "kruschev@soviet.org" @@ -272,7 +271,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Leonid" :last-name "Brezhnev" :email "brezhnev@soviet.org" @@ -283,7 +282,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Yuri" :last-name "Andropov" :email "andropov@soviet.org" @@ -294,7 +293,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Konstantin" :last-name "Chernenko" :email "chernenko@soviet.org" @@ -305,7 +304,7 @@ :groupid 1 :height (1+ (random 1.00)) :married nil - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Mikhail" :last-name "Gorbachev" :email "gorbachev@soviet.org" @@ -316,7 +315,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Boris" :last-name "Yeltsin" :email "yeltsin@soviet.org" @@ -327,7 +326,7 @@ :groupid 1 :married nil :height (1+ (random 1.00)) - :birthday (clsql-base:get-time) + :birthday (clsql:get-time) :first-name "Vladamir" :last-name "Putin" :email "putin@soviet.org" @@ -343,16 +342,20 @@ :addressid 2) employee-address1 (make-instance 'employee-address :emplid 1 - :addressid 1) + :addressid 1 + :verified t) employee-address2 (make-instance 'employee-address :emplid 2 - :addressid 2) + :addressid 2 + :verified t) employee-address3 (make-instance 'employee-address :emplid 3 - :addressid 1) + :addressid 1 + :verified nil) employee-address4 (make-instance 'employee-address :emplid 1 - :addressid 2) + :addressid 2 + :verified nil) employee-address5 (make-instance 'employee-address :emplid 3 :addressid 2) @@ -457,9 +460,9 @@ ****************************************************************************** " report-type - (clsql-base:format-time + (clsql:format-time nil - (clsql-base:utime->time (get-universal-time))) + (clsql:utime->time (get-universal-time))) (lisp-implementation-type) (lisp-implementation-version) (machine-type) @@ -536,9 +539,28 @@ (clsql-base::in test :fdml/select/1)) (push (cons test "fancy math not supported") skip-tests)) ((and (eql *test-database-type* :sqlite) - (clsql-base::in test :fddl/view/4 :fdml/select/10)) + (clsql-base::in test :fddl/view/4 :fdml/select/10 + :fdml/select/21)) (push (cons test "not supported by sqlite") skip-tests)) + ((and (eql *test-database-underlying-type* :mysql) + (clsql-base::in test :fdml/select/22 :fdml/query/5 + :fdml/query/7 :fdml/query/8)) + (push (cons test "not supported by mysql") skip-tests)) (t (push test-form test-forms))))) - (values (nreverse test-forms) (nreverse skip-tests)))) + (values (nreverse test-forms) (nreverse skip-tests)))) + + +(defun rl () + "Rapid load for interactive testing." + (when *default-database* + (disconnect :database *default-database*)) + (test-connect-to-database :postgresql (car (postgresql-spec (read-specs)))) + (test-initialise-database)) +(defun rlm () + "Rapid load for interactive testing." + (when *default-database* + (disconnect :database *default-database*)) + (test-connect-to-database :mysql (car (mysql-spec (read-specs)))) + (test-initialise-database))