tests/ds-nodes.lisp

   1 (in-package #:clsql-tests)
   2
   3 (clsql-sys:file-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 ;; classes for testing the normalizedp stuff
  22 (def-view-class node ()
  23   ((node-id :accessor node-id :initarg :node-id
  24             :type integer :db-kind :key
  25             :db-constraints (:not-null :auto-increment))
  26    (title :accessor title :initarg :title :type (varchar 240))
  27    (createtime :accessor createtime :initarg :createtime :type wall-time
  28                :db-constraints (:not-null) :initform (get-time))
  29    (modifiedtime :accessor modifiedtime :initarg :modifiedtime :type wall-time
  30                  :initform (make-time :year 1900 :month 1 :day 1))))
  31
  32 (def-view-class setting (node)
  33   ((setting-id :accessor setting-id :initarg :setting-id
  34                :type integer :db-kind :key :db-constraints (:not-null ))
  35    (vars :accessor vars :initarg :vars :type (varchar 240)))
  36   (:normalizedp t))
  37
  38 (def-view-class user (node)
  39   ((user-id :accessor user-id :initarg :user-id
  40             :type integer :db-kind :key :db-constraints (:not-null ))
  41    (nick :accessor nick :initarg :nick :type (varchar 64)))
  42   (:base-table "nodeuser")
  43   (:normalizedp 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   (:normalizedp t))
  50
  51 ;; A class that uses only a superclass db table
  52 (def-view-class location (node)
  53   ()
  54   (:base-table node)
  55   (:normalizedp 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   (:normalizedp t))
  62
  63
  64
  65 (defun initialize-ds-nodes ()
  66   ;;  (start-sql-recording :type :both)
  67   (mapc #'clsql:create-view-from-class
  68         '(node setting user theme location subloc))
  69
  70   (setq *test-start-utime* (get-universal-time))
  71   (let* ((*db-auto-sync* t))
  72     (setf  node (make-instance 'node
  73                                :title "Bare node")
  74            setting1 (make-instance 'setting
  75                                    :title "Setting1"
  76                                    :vars "var 1")
  77            setting2 (make-instance 'setting
  78                                    :title "Setting2"
  79                                    :vars "var 2")
  80            user1 (make-instance 'user
  81                                 :title "user-1"
  82                                 :nick "first user")
  83            user2 (make-instance 'user
  84                                 :title "user-2"
  85                                 :nick "second user")
  86            theme1 (make-instance 'theme
  87                                  :title "theme-1"
  88                                  :vars "empty"
  89                                  :doc "first theme")
  90            theme2 (make-instance 'theme
  91                                  :title "theme-2"
  92                                  :doc "second theme")
  93            loc1 (make-instance 'location
  94                                :title "location-1")
  95            loc2 (make-instance 'location
  96                                :title "location-2")
  97            subloc1 (make-instance 'subloc
  98                                   :title "subloc-1"
  99                                   :loc "a subloc")
 100            subloc2 (make-instance 'subloc
 101                                   :title "subloc-2"
 102                                   :loc "second subloc"))))
 103
 104
 105
 106
 107  (def-dataset *ds-nodes*
 108    (:setup initialize-ds-nodes)
 109    (:cleanup (lambda ()
 110                (mapc #'clsql-sys:drop-view-from-class
 111                      '(node setting user theme location subloc))
 112                (ignore-errors
 113                  (clsql-sys:execute-command "DROP TABLE nodeuser")
 114                  (mapc #'clsql-sys:drop-sequence
 115                        '(node_node_id_seq setting_setting_id_seq subloc_subloc_id_seq
 116                          theme_theme_id_seq nodeuser_user_id_seq)
 117                        )))))
 118