Moving object data out of init into separate files and each one made a dataset.

[clsql.git] / tests / ds-nodes.lisp

diff --git a/tests/ds-nodes.lisp b/tests/ds-nodes.lisp
new file mode 100644 (file)
index 0000000..2883b31
--- /dev/null
+++ b/tests/ds-nodes.lisp
@@ -0,0 +1,122 @@
+(in-package #:clsql-tests)
+
+#.(clsql:locally-enable-sql-reader-syntax)
+
+(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)
+
+
+
+;; 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 initialize-ds-nodes ()
+  ;;  (start-sql-recording :type :both)
+  (let ((*backend-warning-behavior*
+         (if (member *test-database-type* '(:postgresql :postgresql-socket))
+             :ignore
+            :warn)))
+    (mapc #'clsql:create-view-from-class
+         '(node setting user theme location subloc)))
+    
+
+  (setq *test-start-utime* (get-universal-time))
+  (let* ((*db-auto-sync* t))
+    (setf  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")))
+
+
+  )
+
+
+
+
+ (def-dataset *ds-employees*
+   (:setup initialize-ds-employees)
+   (:cleanup (lambda ()
+              (mapc #'clsql-sys:drop-view-from-class
+                    '(employee company address employee-address
+                      node setting user theme location subloc)))))
+
+#.(clsql:restore-sql-reader-syntax-state)