tests/ds-nodes.lisp

   1 (in-package #:clsql-tests)
   2
   3 #.(clsql:locally-enable-sql-reader-syntax)
   4
   5 (defparameter basenode nil)
   6 (defparameter derivednode1 nil)
   7 (defparameter derivednode2 nil)
   8 (defparameter node nil)
   9 (defparameter setting1 nil)
  10 (defparameter setting2 nil)
  11 (defparameter user1 nil)
  12 (defparameter user2 nil)
  13 (defparameter theme1 nil)
  14 (defparameter theme2 nil)
  15 (defparameter loc1 nil)
  16 (defparameter loc2 nil)
  17 (defparameter subloc1 nil)
  18 (defparameter subloc2 nil)
  19
  20
  21
  22 ;; classes for testing the normalisedp stuff
  23 (def-view-class node ()
  24   ((node-id :accessor node-id :initarg :node-id
  25             :type integer :db-kind :key
  26             :db-constraints (:not-null :auto-increment))
  27    (title :accessor title :initarg :title :type (varchar 240))
  28    (createtime :accessor createtime :initarg :createtime :type wall-time
  29                :db-constraints (:not-null) :initform (get-time))
  30    (modifiedtime :accessor modifiedtime :initarg :modifiedtime :type wall-time
  31                  :initform (make-time :year 1900 :month 1 :day 1))))
  32
  33 (def-view-class setting (node)
  34   ((setting-id :accessor setting-id :initarg :setting-id
  35                :type integer :db-kind :key :db-constraints (:not-null))
  36    (vars :accessor vars :initarg :vars :type (varchar 240)))
  37   (:normalisedp t))
  38
  39 (def-view-class user (node)
  40   ((user-id :accessor user-id :initarg :user-id
  41             :type integer :db-kind :key :db-constraints (:not-null))
  42    (nick :accessor nick :initarg :nick :type (varchar 64)))
  43   (:normalisedp t))
  44
  45 (def-view-class theme (setting)
  46   ((theme-id :accessor theme-id :initarg :theme-id
  47              :type integer :db-kind :key :db-constraints (:not-null))
  48    (doc :accessor doc :initarg :doc :type (varchar 240)))
  49   (:normalisedp t))
  50
  51 ;; A class that uses only a superclass db table
  52 (def-view-class location (node)
  53   ()
  54   (:base-table node)
  55   (:normalisedp t))
  56
  57 (def-view-class subloc (location)
  58   ((subloc-id :accessor subloc-id :initarg :subloc-id
  59               :type integer :db-kind :key :db-constraints (:not-null))
  60    (loc :accessor loc :initarg :loc :type (varchar 64)))
  61   (:normalisedp t))
  62
  63
  64
  65 (defun initialize-ds-nodes ()
  66   ;;  (start-sql-recording :type :both)
  67   (let ((*backend-warning-behavior*
  68          (if (member *test-database-type* '(:postgresql :postgresql-socket))
  69              :ignore
  70              :warn)))
  71     (mapc #'clsql:create-view-from-class
  72           '(node setting user theme location subloc)))
  73
  74
  75   (setq *test-start-utime* (get-universal-time))
  76   (let* ((*db-auto-sync* t))
  77     (setf  node (make-instance 'node
  78                               :title "Bare node")
  79           setting1 (make-instance 'setting
  80                                   :title "Setting1"
  81                                   :vars "var 1")
  82           setting2 (make-instance 'setting
  83                                   :title "Setting2"
  84                                   :vars "var 2")
  85           user1 (make-instance 'user
  86                                :title "user-1"
  87                                :nick "first user")
  88           user2 (make-instance 'user
  89                                :title "user-2"
  90                                :nick "second user")
  91           theme1 (make-instance 'theme
  92                                 :title "theme-1"
  93                                 :vars "empty"
  94                                 :doc "first theme")
  95           theme2 (make-instance 'theme
  96                                 :title "theme-2"
  97                                 :doc "second theme")
  98           loc1 (make-instance 'location
  99                               :title "location-1")
 100           loc2 (make-instance 'location
 101                               :title "location-2")
 102           subloc1 (make-instance 'subloc
 103                                  :title "subloc-1"
 104                                  :loc "a subloc")
 105           subloc2 (make-instance 'subloc
 106                                  :title "subloc-2"
 107                                  :loc "second subloc")))
 108
 109
 110   )
 111
 112
 113
 114
 115  (def-dataset *ds-employees*
 116    (:setup initialize-ds-employees)
 117    (:cleanup (lambda ()
 118                (mapc #'clsql-sys:drop-view-from-class
 119                      '(employee company address employee-address
 120                        node setting user theme location subloc)))))
 121
 122 #.(clsql:restore-sql-reader-syntax-state)