Changes to more broadly support auto-increment. new odbc-postgresql-database type
[clsql.git] / tests / test-oodml.lisp
index 6ab648a03ac1c30ff2a3adc0ca57af96519295fb..953a604a9adc693a657e2185c66ccab3ce37ecef 100644 (file)
@@ -1,7 +1,6 @@
 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; ======================================================================
 ;;;; File:    test-oodml.lisp
-;;;; Author:  Marcus Pearce <m.t.pearce@city.ac.uk>
 ;;;; Created: 01/04/2004
 ;;;;
 ;;;; Tests for the CLSQL Object Oriented Data Definition Language
@@ -16,7 +15,8 @@
 
 (in-package #:clsql-tests)
 
-#.(clsql:locally-enable-sql-reader-syntax)
+(clsql-sys:file-enable-sql-reader-syntax)
+
 
 (setq *rt-oodml*
       '(
 ;; test retrieval of node, derived nodes etc
 (deftest :oodml/select/12
     (with-dataset *ds-nodes*
-      (length (clsql:select 'node :where [node-id] :flatp t :caching nil)))
+      (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil)))
   11)
 
 (deftest :oodml/select/13
 
 (deftest :oodml/select/14
     (with-dataset *ds-nodes*
-      (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil)))
+      (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil)))
   4)
 
 (deftest :oodml/select/15
 
 (deftest :oodml/select/16
     (with-dataset *ds-nodes*
-      (length (clsql:select 'user :where [user-id] :flatp t :caching nil)))
+      (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil)))
   2)
 
 (deftest :oodml/select/17
 
 (deftest :oodml/select/18
     (with-dataset *ds-nodes*
-      (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil)))
+      (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil)))
   2)
 
 (deftest :oodml/select/19
 
 (deftest :oodml/select/22
     (with-dataset *ds-nodes*
-      (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
+      (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil))))
        (values
          (slot-value a 'node-id)
          (slot-value a 'subloc-id)
          (slot-value a 'loc))))
   10 10 "subloc-1" "a subloc")
 
+(deftest :oodml/select/23
+    (with-dataset *ds-artists*
+      (length (clsql:select 'artist :flatp t :caching nil)))
+  0)
+
+
+
 ;; test retrieval is deferred
 (deftest :oodm/retrieval/1
     (with-dataset *ds-employees*
 
 (deftest :oodm/retrieval/4
     (with-dataset *ds-employees*
-      (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
+      (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
              (select 'employee-address :flatp t :caching nil)))
-  (t t t t t))
+  t)
 
 (deftest :oodm/retrieval/5
     (with-dataset *ds-employees*
-      (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
-             (select 'deferred-employee-address :flatp t :caching nil)))
-  (t t t t t))
+      (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
+             (select 'deferred-employee-address :flatp t :caching nil)))
+  t)
 
 (deftest :oodm/retrieval/6
     (with-dataset *ds-employees*
     (with-dataset *ds-employees*
       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
              (select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
-  (10 10 nil nil nil))
+  (10 10 nil nil nil nil))
 
 (deftest :oodm/retrieval/9
     (with-dataset *ds-employees*
       (mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
              (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
-  (10 10 nil nil nil))
+  (10 10 nil nil nil nil))
 
 ;; tests update-records-from-instance
 (deftest :oodml/update-records/1
 ;; tests update-record-from-slot
 (deftest :oodml/update-records/2
     (with-dataset *ds-employees*
+      ;(start-sql-recording :type :both)
       (values
        (employee-email
         (car (clsql:select 'employee
                            :where [= 1 [slot-value 'employee 'emplid]]
                            :flatp t
                            :caching nil)))
-       (progn
-         (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
-         (clsql:update-record-from-slot employee1 'email)
+       (progn
+         (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
+         (clsql:update-record-from-slot employee1 'email)
          (employee-email
           (car (clsql:select 'employee
                              :where [= 1 [slot-value 'employee 'emplid]]
                 (format nil "~a ~a ~a"
                         (slot-value node 'setting-id)
                         (slot-value node 'title)
-                        (slot-value node 'vars)))))
+                        (or (slot-value node 'vars) "NIL")))))
        (values
          (print-fresh-setting)
          (let ((node (car (clsql:select 'setting
                 (with-slots (node-id setting-id theme-id title vars doc) node
                   (format nil "~a ~a ~a ~a ~a ~a"
                           node-id setting-id theme-id
-                          title vars doc)))))
+                          title (or vars "NIL") doc)))))
        (values
          (print-fresh-theme)
          (let ((node (car (clsql:select 'setting
               (let ((sl (car (clsql:select 'subloc
                                            :where [= 10 [slot-value 'subloc 'subloc-id]]
                                            :flatp t :caching nil))))
+                (unless sl
+                  (error "Couldn't find expected sublocation"))
                 (format nil "~a ~a ~a"
                         (slot-value sl 'subloc-id)
                         (slot-value sl 'title)
               (let ((sl (car (clsql:select 'subloc
                                            :where [= 10 [slot-value 'subloc 'subloc-id]]
                                            :flatp t :caching nil))))
+                (unless sl
+                  (error "In psfl: found no sublocation with id = 10"))
                 (format nil "~a ~a ~a"
                         (slot-value sl 'subloc-id)
                         (slot-value sl 'title)
          (let ((sl (car (clsql:select 'subloc
                                       :where [= 10 [slot-value 'subloc 'subloc-id]]
                                       :flatp t :caching nil))))
+           (unless sl
+             (error "Select for modification: Found no sublocation with id = 10"))
            (setf (slot-value sl 'title) "Altered subloc title")
            (setf (slot-value sl 'loc) "Altered loc")
            (clsql:update-record-from-slot sl 'title)
          (let ((sl (car (clsql:select 'subloc
                                       :where [= 10 [slot-value 'subloc 'subloc-id]]
                                       :flatp t :caching nil))))
+           (unless sl
+             (error "Select for next modification: Found no sublocation with id = 10"))
            (setf (slot-value sl 'title) "subloc-1")
            (setf (slot-value sl 'loc) "a subloc")
-           (clsql:update-record-from-slot sl '(title loc))
+           (clsql:update-record-from-slots sl '(title loc))
            (print-fresh-subloc)))))
   "10 subloc-1 a subloc"
   "10 Altered subloc title Altered loc"
 ;; (was failing in Postgresql at somepoint)
 (deftest :oodml/update-records/10
     (with-dataset *ds-employees*
-      (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp T))))
+      (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
        (setf (height emp) nil)
        (clsql-sys:update-record-from-slot emp 'height)
        (values
   ((42.0d0))
   ((24.13d0)))
 
+(deftest :oodml/update-records/11
+    (with-dataset *ds-artists*
+      (clsql:update-records-from-instance artist1)
+      (list (name artist1) (artist_id artist1)))
+  ("Mogwai" 1))
+
+(deftest :oodml/update-records/12
+    (with-dataset *ds-artists*
+      (clsql:update-records-from-instance artist1)
+      (list (name artist1) (genre artist1)))
+  ("Mogwai" "Unknown"))
 
 ;; tests update-instance-from-records
 (deftest :oodml/update-instance/1
          (format out "~a ~a ~a ~a"
                  (slot-value theme2 'theme-id)
                  (slot-value theme2 'title)
-                 (slot-value theme2 'vars)
+                 (or (slot-value theme2 'vars) "NIL")
                  (slot-value theme2 'doc)))
        (progn
          (clsql:update-records [node] :av-pairs '(([title] "Altered title"))
        (progn
          (clsql:update-records [node]
                                :av-pairs '(([title] "altered title"))
-                               :where [= [node-id] 9])
+                               :where [= [node-id] (node-id loc2)])
          (clsql:update-slot-from-record loc2 'title)
          (print-loc loc2))
        (progn
          (clsql:update-records [subloc]
                                :av-pairs '(([loc] "altered loc"))
-                               :where [= [subloc-id] 11])
+                               :where [= [subloc-id] (subloc-id subloc2)])
          (clsql:update-slot-from-record subloc2 'loc)
          (print-subloc subloc2)))))
   "9: location-2" "11: second subloc"
 
 (deftest :oodml/cache/1
     (with-dataset *ds-employees*
-      (progn
+      (let ((*default-caching* t))
        (setf (clsql-sys:record-caches *default-database*) nil)
        (let ((employees (select 'employee)))
          (every #'(lambda (a b) (eq a b))
 
 (deftest :oodml/cache/2
     (with-dataset *ds-employees*
-      (let ((employees (select 'employee)))
+      (let* ((*default-caching* t)
+             (employees (select 'employee)))
        (equal employees (select 'employee :flatp t))))
   nil)
 
 (deftest :oodml/refresh/1
     (with-dataset *ds-employees*
-      (let ((addresses (select 'address)))
+      (let* ((clsql-sys:*default-caching* t)
+             (addresses (select 'address)))
        (equal addresses (select 'address :refresh t))))
   t)
 
 (deftest :oodml/refresh/2
     (with-dataset *ds-employees*
-      (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+      (let* ((clsql-sys:*default-caching* t)
+             (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
             (city (slot-value (car addresses) 'city)))
        (clsql:update-records [addr]
                              :av-pairs '((city_field "A new city"))
 
 (deftest :oodml/refresh/3
     (with-dataset *ds-employees*
-      (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
+      (let* ((clsql-sys:*default-caching* t)
+             (addresses (select 'address :order-by [addressid] :flatp t)))
        (values
          (equal addresses (select 'address :refresh t :flatp t))
          (equal addresses (select 'address :flatp t)))))
 
 (deftest :oodml/refresh/4
     (with-dataset *ds-employees*
-      (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+      (let* ((clsql-sys:*default-caching* t)
+             (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
             (*db-auto-sync* t))
        (make-instance 'address :addressid 1000 :city "A new address city")
        (let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
-         (delete-records :from [addr] :where [= [addressid] 1000])
          (values
            (length addresses)
            (length new-addresses)
            (eq (first addresses) (first new-addresses))
            (eq (second addresses) (second new-addresses))))))
-  2 3 t t)
+  3 4 t t)
 
 
-(deftest :oodml/uoj/1
+(deftest :oodml/uoj/full-set
     (with-dataset *ds-employees*
       (progn
-       (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
-                                :flatp t))
+       (let* ((dea-list (select 'deferred-employee-address
+                           :caching nil :order-by ["ea_join" aaddressid]
+                           :flatp t))
               (dea-list-copy (copy-seq dea-list))
               (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
-         (update-objects-joins dea-list)
+         (update-objects-joins dea-list :slots 'address :max-len nil)
          (values
            initially-unbound
            (equal dea-list dea-list-copy)
            (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
            (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
            (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
-  t t t t (1 1 2 2 2))
+  t t t t (1 1 2 2 2 3))
+
+(deftest :oodml/uoj/batched
+    (with-dataset *ds-employees*
+      (progn
+        (let* ((dea-list (select 'deferred-employee-address
+                           :caching nil :order-by ["ea_join" aaddressid]
+                           :flatp t))
+               (dea-list-copy (copy-seq dea-list))
+               (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
+          (update-objects-joins dea-list :slots 'address :max-len 2)
+          (values
+           initially-unbound
+           (equal dea-list dea-list-copy)
+           (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
+           (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
+           (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
+  t t t t (1 1 2 2 2 3))
 
 ;; update-object-joins needs to be fixed for multiple keys
 #+ignore
-(deftest :oodml/uoj/2
+(deftest :oodml/uoj/multi-key
     (progn
       (clsql:update-objects-joins (list company1))
       (mapcar #'(lambda (e)
       (values
        (let ((inst (make-instance 'theme
                                   :title "test-theme" :vars "test-vars"
-                                  :doc "test-doc")))
+                                  :doc "test-doc"))
+              (*print-circle* nil))
          (setf (slot-value inst 'title) "alternate-test-theme")
          (format nil "~a ~a ~a ~a"
-                 (select [title] :from [node]
-                         :where [= [title] "test-theme"]
-                         :flatp t :field-names nil)
-                 (select [vars] :from [setting]
-                         :where [= [vars] "test-vars"]
-                         :flatp t :field-names nil)
-                 (select [doc] :from [theme]
-                         :where [= [doc] "test-doc"]
-                         :flatp t :field-names nil)
-                 (select [title] :from [node]
-                         :where [= [title] "alternate-test-theme"]
-                         :flatp t :field-names nil)))
+                 (or (select [title] :from [node]
+                              :where [= [title] "test-theme"]
+                              :flatp t :field-names nil) "NIL")
+                 (or (select [vars] :from [setting]
+                              :where [= [vars] "test-vars"]
+                              :flatp t :field-names nil) "NIL")
+                 (or (select [doc] :from [theme]
+                              :where [= [doc] "test-doc"]
+                              :flatp t :field-names nil) "NIL")
+                 (or (select [title] :from [node]
+                              :where [= [title] "alternate-test-theme"]
+                              :flatp t :field-names nil) "NIL")))
        (let* ((*db-auto-sync* t)
               (inst (make-instance 'theme
                                    :title "test-theme" :vars "test-vars"
          (setf (slot-value inst 'title) "alternate-test-theme")
          (prog1
              (format nil "~a ~a ~a ~a"
-                     (select [title] :from [node]
-                             :where [= [title] "test-theme"]
-                             :flatp t :field-names nil)
-                     (select [vars] :from [setting]
-                             :where [= [vars] "test-vars"]
-                             :flatp t :field-names nil)
-                     (select [doc] :from [theme]
-                             :where [= [doc] "test-doc"]
-                             :flatp t :field-names nil)
-                     (select [title] :from [node]
-                             :where [= [title] "alternate-test-theme"]
-                             :flatp t :field-names nil))
+                     (or (select [title] :from [node]
+                                  :where [= [title] "test-theme"]
+                                  :flatp t :field-names nil) "NIL")
+                     (or (select [vars] :from [setting]
+                                  :where [= [vars] "test-vars"]
+                                  :flatp t :field-names nil) "NIL")
+                     (or (select [doc] :from [theme]
+                                  :where [= [doc] "test-doc"]
+                                  :flatp t :field-names nil) "NIL")
+                     (or (select [title] :from [node]
+                                  :where [= [title] "alternate-test-theme"]
+                                  :flatp t :field-names nil) "NIL"))
            (delete-records :from [node] :where [= [title] "alternate-test-theme"])
            (delete-records :from [setting] :where [= [vars] "test-vars"])
            (delete-records :from [theme] :where [= [doc] "test-doc"])))))
 ))
 
 
-
-#.(clsql:restore-sql-reader-syntax-state)