1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; ======================================================================
3 ;;;; File: test-ooddl.lisp
4 ;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
5 ;;;; Created: 30/03/2004
8 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
11 ;;;; This file is part of CLSQL.
13 ;;;; CLSQL users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
16 ;;;; ======================================================================
19 (in-package #:clsql-tests)
21 #.(clsql:locally-enable-sql-reader-syntax)
24 (def-view-class big ()
25 ((i :type integer :initarg :i)
26 (bi :type bigint :initarg :bi)))
30 (clsql-sys:create-view-from-class 'big)
31 (let ((max (expt 2 60)))
33 (update-records-from-instance
34 (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))))
36 (lambda () (clsql-sys:drop-view-from-class 'big))))
41 ;; Ensure slots inherited from standard-classes are :virtual
42 (deftest :ooddl/metaclass/1
44 (clsql-sys::view-class-slot-db-kind
45 (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial
46 (find-class 'person)))
47 (clsql-sys::view-class-slot-db-kind
48 (clsql-sys::slotdef-for-slot-with-class 'hobby (find-class 'person))))
51 ;; Ensure all slots in view-class are view-class-effective-slot-definition
52 (deftest :ooddl/metaclass/2
54 (every #'(lambda (slotd)
55 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
56 (clsql-sys::class-slots (find-class 'person)))
57 (every #'(lambda (slotd)
58 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
59 (clsql-sys::class-slots (find-class 'employee)))
60 (every #'(lambda (slotd)
61 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
62 (clsql-sys::class-slots (find-class 'setting)))
63 (every #'(lambda (slotd)
64 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
65 (clsql-sys::class-slots (find-class 'theme)))
66 (every #'(lambda (slotd)
67 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
68 (clsql-sys::class-slots (find-class 'node)))
69 (every #'(lambda (slotd)
70 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
71 (clsql-sys::class-slots (find-class 'company))))
74 ;; Ensure classes are correctly marked normalised or not, default not
75 ;(deftest :ooddl/metaclass/3
77 ; (clsql-sys::normalisedp derivednode1)
78 ; (clsql-sys::normalisedp basenode)
79 ; (clsql-sys::normalisedp company1)
80 ; (clsql-sys::normalisedp employee3)
81 ; (clsql-sys::normalisedp derivednode-sc-2))
84 ;(deftest :ooddl/metaclass/3
86 ; (normalisedp (find-class 'baseclass))
87 ; (normalisedp (find-class 'normderivedclass)))
90 (deftest :ooddl/join/1
91 (with-dataset *ds-employees*
92 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
93 (company-employees company1)))
94 (1 1 1 1 1 1 1 1 1 1))
96 (deftest :ooddl/join/2
97 (with-dataset *ds-employees*
98 (slot-value (president company1) 'last-name))
101 (deftest :ooddl/join/3
102 (with-dataset *ds-employees*
103 (slot-value (employee-manager employee2) 'last-name))
106 (deftest :ooddl/big/1
107 ;;tests that we can create-view-from-class with a bigint slot,
108 ;; and stick a value in there.
109 (progn (clsql-sys:create-view-from-class 'big)
111 (clsql:table-exists-p [big] :owner *test-database-user*)
113 (clsql:drop-table [big] :if-does-not-exist :ignore)
114 (clsql:table-exists-p [big] :owner *test-database-user*)))
118 (deftest :ooddl/big/2
119 (with-dataset *ds-big*
120 (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil)))
125 (rest rows (cdr rest)))
126 ((= i (length rows)) t)
128 (int (first (car rest)))
129 (bigint (second (car rest))))
130 (when (and (or (eq *test-database-type* :oracle)
131 (and (eq *test-database-type* :odbc)
132 (eq *test-database-underlying-type* :postgresql)))
134 (setf bigint (parse-integer bigint)))
135 (unless (and (eql int index)
136 (eql bigint (truncate max index)))
140 (deftest :ooddl/time/1
141 (with-dataset *ds-employees*
142 (sleep 1) ;force birthdays into the past
143 (let* ((now (clsql:get-time)))
144 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
145 (clsql:execute-command "set datestyle to 'iso'"))
146 (clsql:update-records [employee] :av-pairs `((birthday ,now))
147 :where [= [emplid] 1])
148 (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
151 (slot-value dbobj 'last-name)
152 (clsql:time= (slot-value dbobj 'birthday) now)))))
155 (deftest :ooddl/time/2
156 (with-dataset *ds-employees*
157 (sleep 1) ;force birthdays into the past
158 (let* ((now (clsql:get-time))
160 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
161 (clsql:execute-command "set datestyle to 'iso'"))
163 (clsql:update-records [employee] :av-pairs `((birthday ,now))
164 :where [= [emplid] 1])
165 (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
167 (unless (clsql:time= (slot-value dbobj 'birthday) now)
169 (setf now (clsql:roll now :day (* 10 x)))))
173 (deftest :ooddl/time/3
174 (with-dataset *ds-employees*
176 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
177 (clsql:execute-command "set datestyle to 'iso'"))
178 (let ((dbobj (car (clsql:select 'employee :where [= [emplid] 10]
181 (eql *test-start-utime* (slot-value dbobj 'bd-utime))
182 (clsql:time= (slot-value dbobj 'birthday)
183 (clsql:utime->time (slot-value dbobj 'bd-utime)))))))
188 #.(clsql:restore-sql-reader-syntax-state)