ds-artists: new test dataset ds-artists. clsql-tests.asd: add new filee ds-artists...

[clsql.git] / tests / test-oodml.lisp

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index ca1b7f81077780126ecd49865de21f436c73dff3..d1c933a432d75c8340b047651fbe092590457efa 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -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
@@ -212,6 +211,11 @@
          (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*
@@ -458,7 +462,7 @@
                 (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
@@ -511,7 +515,7 @@
                 (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
@@ -594,6 +598,32 @@
   "10 Altered subloc title Altered loc"
   "10 subloc-1 a subloc")
 
+;; Verify that we can set a float to nil and then read it back
+;; (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))))
+       (setf (height emp) nil)
+       (clsql-sys:update-record-from-slot emp 'height)
+       (values
+         (clsql:select [height] :from [employee] :where [= [emplid] 1])
+         (progn
+           (setf (height emp) 42.0)
+           (clsql-sys:update-record-from-slot emp 'height)
+           (clsql:select [height] :from [employee] :where [= [emplid] 1]))
+         (progn
+           (setf (height emp) 24.13d0)
+           (clsql-sys:update-record-from-slot emp 'height)
+           (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
+  ((nil))
+  ((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))
 
 ;; tests update-instance-from-records
 (deftest :oodml/update-instance/1
@@ -630,7 +660,7 @@
          (slot-value employee1 'email))))
   "lenin@soviet.org" "lenin-nospam@soviet.org")
 
-;; tests normalisedp update-instance-from-records
+;; tests normalizedp update-instance-from-records
 (deftest :oodml/update-instance/3
     (with-dataset *ds-nodes*
       (values
@@ -638,7 +668,7 @@
          (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"))
@@ -697,7 +727,7 @@
   "11 subloc-2 second subloc"
   "11 Altered title Altered loc")
 
-;; tests update-slot-from-record with normalisedp stuff
+;; tests update-slot-from-record with normalizedp stuff
 (deftest :oodml/update-instance/6
     (with-dataset *ds-nodes*
       (values
@@ -950,21 +980,22 @@
       (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"
@@ -972,18 +1003,18 @@
          (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"])))))