X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-init.lisp;h=f88fb91c1b0c0f1568f77812d43f86eda0b747d9;hb=0e06463bcfc9e4f9d1eec15b7746eb7f07cf2f2b;hp=b0a902ca0502c8bd54c13ea1d3747df0f3ebdf84;hpb=5ed1f05543cbd24b3f2bb735f2cfc03ea85e51ec;p=clsql.git

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index b0a902c..f88fb91 100644
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -3,7 +3,6 @@
 ;;;; File:    test-init.lisp
 ;;;; Authors: Marcus Pearce <m.t.pearce@city.ac.uk>, Kevin Rosenberg
 ;;;; Created: 30/03/2004
-;;;; Updated: $Id$
 ;;;;
 ;;;; Initialisation utilities for running regression tests on CLSQL.
 ;;;;
@@ -190,6 +189,48 @@
   ((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)
   (when (clsql-sys:db-backend-has-create/destroy-db? db-type)
     (ignore-errors (destroy-database spec :database-type db-type))
@@ -233,18 +274,40 @@
 (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 ()
-  (test-basic-initialize)
+;;  (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 '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)
@@ -399,7 +462,39 @@
                                            :verified nil)
           employee-address5 (make-instance 'employee-address
                                            :emplid 3
-                                           :addressid 2))
+                                           :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)
@@ -530,7 +625,7 @@
 
            (write-report-banner "Test Suite" db-type *report-stream*)
 
-           (test-initialise-database)
+;           (test-initialise-database)
 
            (regression-test:rem-all-tests)
            (dolist (test-form test-forms)
@@ -642,7 +737,7 @@
   (when *default-database*
       (disconnect :database *default-database*))
   (test-connect-to-database type (nth position (db-type-spec type (read-specs))))
-  (test-initialise-database)
+  ;(test-initialise-database)
   *default-database*)
 
 (defun rl ()