X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=d0c9bca8490e29902b89c96babb2559bbb2c738c;hp=f88fb91c1b0c0f1568f77812d43f86eda0b747d9;hb=9374619101fdb679974192b5939c0eb15e31c39d;hpb=3b275bb881881a06d85fa6769983a7cfc6e997a1

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index f88fb91..d0c9bca 100644
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -34,201 +34,8 @@
 (defvar *test-connection-spec* nil)
 (defvar *test-connection-db-type* nil)
 
-(defclass thing ()
-  ((extraterrestrial :initform nil :initarg :extraterrestrial)))
-
-(def-view-class person (thing)
-  ((height :db-kind :base :accessor height :type float
-           :initarg :height)
-   (married :db-kind :base :accessor married :type boolean
-            :initarg :married)
-   (birthday :type clsql:wall-time :initarg :birthday)
-   (bd-utime :type clsql:universal-time :initarg :bd-utime)
-   (hobby :db-kind :virtual :initarg :hobby :initform nil)))
-
-(def-view-class employee (person)
-  ((emplid
-    :db-kind :key
-    :db-constraints (:not-null :unique)
-    :type integer
-    :initarg :emplid)
-   (groupid
-    :db-kind :key
-    :db-constraints :not-null
-    :type integer
-    :initarg :groupid)
-   (first-name
-    :accessor first-name
-    :type (varchar 30)
-    :initarg :first-name)
-   (last-name
-    :accessor last-name
-    :type (varchar 30)
-    :initarg :last-name)
-   (email
-    :accessor employee-email
-    :type (varchar 100)
-    :initarg :email)
-   (ecompanyid
-    :type integer
-    :initarg :companyid)
-   (company
-    :accessor employee-company
-    :db-kind :join
-    :db-info (:join-class company
-                          :home-key ecompanyid
-                          :foreign-key companyid
-                          :set nil))
-   (managerid
-    :type integer
-    :initarg :managerid)
-   (manager
-    :accessor employee-manager
-    :db-kind :join
-    :db-info (:join-class employee
-                          :home-key managerid
-                          :foreign-key emplid
-                          :set nil))
-   (addresses
-    :accessor employee-addresses
-    :db-kind :join
-    :db-info (:join-class employee-address
-                          :home-key emplid
-                          :foreign-key aemplid
-                          :target-slot address
-                          :set t)))
-  (:base-table employee))
-
-(def-view-class company ()
-  ((companyid
-    :db-kind :key
-    :db-constraints :not-null
-    :type integer
-    :initarg :companyid)
-   (groupid
-    :db-kind :key
-    :db-constraints :not-null
-    :type integer
-    :initarg :groupid)
-   (name
-    :type (varchar 100)
-    :initarg :name)
-   (presidentid
-    :type integer
-    :initarg :presidentid)
-   (president
-    :reader president
-    :db-kind :join
-    :db-info (:join-class employee
-                          :home-key presidentid
-                          :foreign-key emplid
-                          :set nil))
-   (employees
-    :reader company-employees
-    :db-kind :join
-    :db-info (:join-class employee
-                          :home-key (companyid groupid)
-                          :foreign-key (ecompanyid groupid)
-                          :set t))))
-
-(def-view-class address ()
-  ((addressid
-    :db-kind :key
-    :db-constraints :not-null
-    :type integer
-    :initarg :addressid)
-   (street-number
-    :type integer
-    :initarg :street-number)
-   (street-name
-    :type (varchar 30)
-    :void-value ""
-    :initarg :street-name)
-   (city
-    :column "city_field"
-    :void-value "no city"
-    :type (varchar 30)
-    :initarg :city)
-   (postal-code
-    :column zip
-    :type integer
-    :void-value 0
-    :initarg :postal-code))
-  (:base-table addr))
-
-;; many employees can reside at many addressess
-(def-view-class employee-address ()
-  ((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 aaddressid
-                                  :foreign-key addressid
-                                  :retrieval :immediate))
-   (employee :db-kind :join
-             :db-info (:join-class employee
-                                  :home-key aemplid
-                                  :foreign-key emplid
-                                  :retrieval :immediate)))
-  (:base-table "ea_join"))
-
-(def-view-class deferred-employee-address ()
-  ((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 aaddressid
-                                  :foreign-key addressid
-                                  :retrieval :deferred
-                                  :set nil)))
-  (:base-table "ea_join"))
-
-(def-view-class big ()
-  ((i :type integer :initarg :i)
-   (bi :type bigint :initarg :bi)))
-
-;; classes for testing the normalisedp stuff
-(def-view-class node ()
-  ((node-id :accessor node-id :initarg :node-id
-            :type integer :db-kind :key
-            :db-constraints (:not-null :auto-increment))
-   (title :accessor title :initarg :title :type (varchar 240))
-   (createtime :accessor createtime :initarg :createtime :type wall-time
-               :db-constraints (:not-null) :initform (get-time))
-   (modifiedtime :accessor modifiedtime :initarg :modifiedtime :type wall-time
-                 :initform (make-time :year 1900 :month 1 :day 1))))
-
-(def-view-class setting (node)
-  ((setting-id :accessor setting-id :initarg :setting-id
-               :type integer :db-kind :key :db-constraints (:not-null))
-   (vars :accessor vars :initarg :vars :type (varchar 240)))
-  (:normalisedp t))
-
-(def-view-class user (node)
-  ((user-id :accessor user-id :initarg :user-id
-            :type integer :db-kind :key :db-constraints (:not-null))
-   (nick :accessor nick :initarg :nick :type (varchar 64)))
-  (:normalisedp t))
-
-(def-view-class theme (setting)
-  ((theme-id :accessor theme-id :initarg :theme-id
-             :type integer :db-kind :key :db-constraints (:not-null))
-   (doc :accessor doc :initarg :doc :type (varchar 240)))
-  (:normalisedp t))
-
-;; A class that uses only a superclass db table
-(def-view-class location (node)
-  ()
-  (:base-table node)
-  (:normalisedp t))
-
-(def-view-class subloc (location)
-  ((subloc-id :accessor subloc-id :initarg :subloc-id
-			  :type integer :db-kind :key :db-constraints (:not-null))
-   (loc :accessor loc :initarg :loc :type (varchar 64)))
-  (:normalisedp t))
+
+
 
 
 (defun test-connect-to-database (db-type spec)
@@ -256,296 +63,6 @@
 
   *default-database*)
 
-(defparameter company1 nil)
-(defparameter employee1 nil)
-(defparameter employee2 nil)
-(defparameter employee3 nil)
-(defparameter employee4 nil)
-(defparameter employee5 nil)
-(defparameter employee6 nil)
-(defparameter employee7 nil)
-(defparameter employee8 nil)
-(defparameter employee9 nil)
-(defparameter employee10 nil)
-(defparameter address1 nil)
-(defparameter address2 nil)
-(defparameter employee-address1 nil)
-(defparameter employee-address2 nil)
-(defparameter employee-address3 nil)
-(defparameter employee-address4 nil)
-(defparameter employee-address5 nil)
-(defparameter basenode nil)
-(defparameter derivednode1 nil)
-(defparameter derivednode2 nil)
-(defparameter node nil)
-(defparameter setting1 nil)
-(defparameter setting2 nil)
-(defparameter user1 nil)
-(defparameter user2 nil)
-(defparameter theme1 nil)
-(defparameter theme2 nil)
-(defparameter loc1 nil)
-(defparameter loc2 nil)
-(defparameter subloc1 nil)
-(defparameter subloc2 nil)
-
-
-(defun test-initialise-database ()
-;;  (start-sql-recording :type :both)
-  (let ((*backend-warning-behavior*
-         (if (member *test-database-type* '(:postgresql :postgresql-socket))
-             :ignore
-           :warn)))
-    ;; (clsql:create-view-from-class 'employee)
-    ;; (clsql:create-view-from-class 'company)
-    ;; (clsql:create-view-from-class 'address)
-    ;; (clsql:create-view-from-class 'employee-address)
-    ;; (clsql:create-view-from-class 'big)
-    ;; (clsql:create-view-from-class 'node)
-    ;; (clsql:create-view-from-class 'setting)
-    ;; (clsql:create-view-from-class 'user)
-    ;; (clsql:create-view-from-class 'theme)
-    ;; (clsql:create-view-from-class 'location)
-    ;; (clsql:create-view-from-class 'subloc)
-    )
-
-  (setq *test-start-utime* (get-universal-time))
-  (let* ((*db-auto-sync* t)
-         (now-time (clsql:utime->time *test-start-utime*)))
-    (setf company1 (make-instance 'company
-                                  :presidentid 1
-                                  :companyid 1
-                                  :groupid 1
-                                  :name "Widgets Inc.")
-          employee1 (make-instance 'employee
-                                   :emplid 1
-                                   :groupid 1
-                                   :married t
-                                   :height (1+ (random 1.00))
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Vladimir"
-                                   :last-name "Lenin"
-                                   :email "lenin@soviet.org"
-                                   :companyid 1)
-          employee2 (make-instance 'employee
-                                   :emplid 2
-                                   :groupid 1
-                                   :height (1+ (random 1.00))
-                                   :married t
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Josef"
-                                   :last-name "Stalin"
-                                   :email "stalin@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee3 (make-instance 'employee
-                                   :emplid 3
-                                   :groupid 1
-                                   :height (1+ (random 1.00))
-                                   :married t
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Leon"
-                                   :last-name "Trotsky"
-                                   :email "trotsky@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee4 (make-instance 'employee
-                                   :emplid 4
-                                   :groupid 1
-                                   :height (1+ (random 1.00))
-                                   :married nil
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Nikita"
-                                   :last-name "Kruschev"
-                                   :email "kruschev@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee5 (make-instance 'employee
-                                   :emplid 5
-                                   :groupid 1
-                                   :married nil
-                                   :height (1+ (random 1.00))
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Leonid"
-                                   :last-name "Brezhnev"
-                                   :email "brezhnev@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee6 (make-instance 'employee
-                                   :emplid 6
-                                   :groupid 1
-                                   :married nil
-                                   :height (1+ (random 1.00))
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Yuri"
-                                   :last-name "Andropov"
-                                   :email "andropov@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee7 (make-instance 'employee
-                                   :emplid 7
-                                   :groupid 1
-                                   :height (1+ (random 1.00))
-                                   :married nil
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Konstantin"
-                                   :last-name "Chernenko"
-                                   :email "chernenko@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee8 (make-instance 'employee
-                                   :emplid 8
-                                   :groupid 1
-                                   :height (1+ (random 1.00))
-                                   :married nil
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Mikhail"
-                                   :last-name "Gorbachev"
-                                   :email "gorbachev@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee9 (make-instance 'employee
-                                   :emplid 9
-                                   :groupid 1
-                                   :married nil
-                                   :height (1+ (random 1.00))
-                                   :bd-utime *test-start-utime*
-                                   :birthday now-time
-                                   :first-name "Boris"
-                                   :last-name "Yeltsin"
-                                   :email "yeltsin@soviet.org"
-                                   :managerid 1
-                                   :companyid 1)
-          employee10 (make-instance 'employee
-                                    :emplid 10
-                                    :groupid 1
-                                    :married nil
-                                    :height (1+ (random 1.00))
-                                    :bd-utime *test-start-utime*
-                                    :birthday now-time
-                                    :first-name "Vladimir"
-                                    :last-name "Putin"
-                                    :email "putin@soviet.org"
-                                    :managerid 1
-                                    :companyid 1)
-          address1 (make-instance 'address
-                                  :addressid 1
-                                  :street-number 10
-                                  :street-name "Park Place"
-                                  :city "Leningrad"
-                                  :postal-code 123)
-          address2 (make-instance 'address
-                                  :addressid 2)
-          employee-address1 (make-instance 'employee-address
-                                           :emplid 1
-                                           :addressid 1
-                                           :verified t)
-          employee-address2 (make-instance 'employee-address
-                                           :emplid 2
-                                           :addressid 2
-                                           :verified t)
-          employee-address3 (make-instance 'employee-address
-                                           :emplid 3
-                                           :addressid 1
-                                           :verified nil)
-          employee-address4 (make-instance 'employee-address
-                                           :emplid 1
-                                           :addressid 2
-                                           :verified nil)
-          employee-address5 (make-instance 'employee-address
-                                           :emplid 3
-                                           :addressid 2)
-          node (make-instance 'node
-                              :title "Bare node")
-          setting1 (make-instance 'setting
-                                  :title "Setting1"
-                                  :vars "var 1")
-          setting2 (make-instance 'setting
-                                  :title "Setting2"
-                                  :vars "var 2")
-          user1 (make-instance 'user
-                               :title "user-1"
-                               :nick "first user")
-          user2 (make-instance 'user
-                               :title "user-2"
-                               :nick "second user")
-          theme1 (make-instance 'theme
-                                :title "theme-1"
-                                :vars "empty"
-                                :doc "first theme")
-          theme2 (make-instance 'theme
-                                :title "theme-2"
-                                :doc "second theme")
-		  loc1 (make-instance 'location
-                              :title "location-1")
-		  loc2 (make-instance 'location
-                              :title "location-2")
-		  subloc1 (make-instance 'subloc
-								 :title "subloc-1"
-								 :loc "a subloc")
-		  subloc2 (make-instance 'subloc
-								 :title "subloc-2"
-								 :loc "second subloc"))
-
-
-    (let ((max (expt 2 60)))
-      (dotimes (i 555)
-        (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))
-
-  ;; sleep to ensure birthdays are no longer at current time
-  (sleep 1)
-
-  #||
-  ;; Lenin manages everyone
-  (clsql:add-to-relation employee2 'manager employee1)
-  (clsql:add-to-relation employee3 'manager employee1)
-  (clsql:add-to-relation employee4 'manager employee1)
-  (clsql:add-to-relation employee5 'manager employee1)
-  (clsql:add-to-relation employee6 'manager employee1)
-  (clsql:add-to-relation employee7 'manager employee1)
-  (clsql:add-to-relation employee8 'manager employee1)
-  (clsql:add-to-relation employee9 'manager employee1)
-  (clsql:add-to-relation employee10 'manager employee1)
-  ;; Everyone works for Widgets Inc.
-  (clsql:add-to-relation company1 'employees employee1)
-  (clsql:add-to-relation company1 'employees employee2)
-  (clsql:add-to-relation company1 'employees employee3)
-  (clsql:add-to-relation company1 'employees employee4)
-  (clsql:add-to-relation company1 'employees employee5)
-  (clsql:add-to-relation company1 'employees employee6)
-  (clsql:add-to-relation company1 'employees employee7)
-  (clsql:add-to-relation company1 'employees employee8)
-  (clsql:add-to-relation company1 'employees employee9)
-  (clsql:add-to-relation company1 'employees employee10)
-  ;; Lenin is president of Widgets Inc.
-  (clsql:add-to-relation company1 'president employee1)
-  ||#
-
-  ;; store these instances
-  #||
-  (clsql:update-records-from-instance employee1)
-  (clsql:update-records-from-instance employee2)
-  (clsql:update-records-from-instance employee3)
-  (clsql:update-records-from-instance employee4)
-  (clsql:update-records-from-instance employee5)
-  (clsql:update-records-from-instance employee6)
-  (clsql:update-records-from-instance employee7)
-  (clsql:update-records-from-instance employee8)
-  (clsql:update-records-from-instance employee9)
-  (clsql:update-records-from-instance employee10)
-  (clsql:update-records-from-instance company1)
-  (clsql:update-records-from-instance address1)
-  (clsql:update-records-from-instance address2)
-  ||#
-  )
 
 (defvar *error-count* 0)
 (defvar *error-list* nil)