;;;; 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.
;;;;
((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))
(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
(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 '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)
: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)
(defun run-tests (&key (report-stream *standard-output*) (sexp-report-stream nil))
+ ;; clear SQL-OUTPUT cache
+ (setq clsql-sys::*output-hash* (make-hash-table :test #'equal))
(let ((specs (read-specs))
(*report-stream* report-stream)
(*sexp-report-stream* sexp-report-stream)