Proposed abstraction for datasets.

diff --git a/tests/datasets.lisp b/tests/datasets.lisp
new file mode 100644 (file)
index 0000000..b464d9e
--- /dev/null
+++ b/tests/datasets.lisp
@@ -0,0 +1,144 @@
+;;;; Proposed new file in clsql-tests to enable abstracting datasets for reuse.
+;;;;
+;;;; The core is def-datset and with-dataset that respectively define a set,
+;;;; and enable one for a dynamic scope. Datasets will normally be setup and
+;;;; torn down in the scope of one test, which may impose a computation
+;;;; overhead, but enables simpler tests by not worrying about side-effects
+;;;; between tests.
+;;;;
+;;;; In general datsets should be database agnostic, but because the code
+;;;; is only run in the scope of a test, if a test is excluded for a backend
+;;;; or some other reason then it is never run hence doesn't cause problems.
+
+(in-package #:clsql-tests)
+
+(defmacro def-dataset (name &body body)
+  "Define a dataset"
+  ;;probably just shove this into a param, perhaps a marginal
+  ;; bit of processing first.
+  `(defparameter ,name ',body))
+
+;;incomplete example taken from test-init
+(def-dataset *employees*
+  (:setup "CREATE TABLE EMPLOYEES (
+emplid int not null,
+groupid int not null,
+married boolean not null,
+first_name varchar (50),
+last_name varchar (50))" ))
+;;alternatively setup can still be done as
+;;(:setup #'(lambda () (create-view-from-class ...)))
+  (:data "employees"
+   (:columns "emplid,groupid,married,height,first_name,last_name")
+   (:values "1,1,false,1.5,'Napolean', 'Bonaparte'")
+   (:values (format nil "1,1,true,~a,'Vladimir','Lenin'" (1+ (random 1.00)))))
+  (:cleanup "DROP TABLE EMPLOYEES"))
+
+
+(defmacro with-dataset (name &body body)
+  "Use a dataset in a dynamic scope, e.g. a single test.
+1. Before the body:
+  * :setup is run
+  * :data is loaded
+2. Body
+3. :cleanup always happens"
+  `(unwind-protect
+       (progn (%dataset-init ,name)
+              ,@body)
+     (handler-case (%dataset-cleanup ,name)
+       (error #'print-the-error)) ;;recursive error catch
+     ))
+
+
+(defun %dataset-dispatch (arg)
+  "For use with def-dataset and with-dataset, tries to DWIM."
+  (etypecase arg
+    (string (clsql-sys:execute-command arg))  ;;treat it as a sql command.
+    ((or function symbol) (funcall fn))  ;;run functions
+    (list (mapc #'%dataset-dispatch arg)))) ;;lists are implicity progn
+
+(defun %dataset-init (name)
+  "Run initialization code and fill database for given dataset."
+  (let ((setup (find :setup name :key #'first))
+       (data (find :data name :key #'first)))
+    (when setup
+      (%dataset-dispatch setup))
+    (when data
+      ;;run raw sql insert statements,
+      ;; other schemes can be done as a function in setup.
+      ;; most likely implemented with something like
+      (let (table-name columns values-list) ;gather components
+       (dolist (v values-list)
+         (clsql-sys:execute-command
+          (format nil "INSERT INTO ~a (~a) VALUES (~a)"
+                  table-name columns v)))))))
+
+(defun %dataset-cleanup (name)
+  "Run cleanup code associated with the given dataset."
+  (%dataset-dispatch (find :cleanup name)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Example Test Code
+
+;;example old test
+(deftest :oodml/select/1
+    (mapcar #'(lambda (e) (slot-value e 'last-name))
+           (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
+  ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
+             "Stalin" "Trotsky" "Yeltsin"))
+
+;;just wrap in the with-dataset
+(deftest :oodml/select/1
+    (with-dataset (*employees*)
+      (mapcar #'(lambda (e) (slot-value e 'last-name))
+             (clsql:select 'employee :order-by [last-name]
+                           :flatp t :caching nil)))
+  ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
+             "Stalin" "Trotsky" "Yeltsin"))
+
+
+;;old
+(deftest :oodml/update-records/4
+         (flet ((print-fresh-node ()
+                  (let ((base (car (clsql:select 'node
+                                     :where [= 1 [slot-value 'node 'node-id]]
+                                     :flatp t :caching nil))))
+                    (format nil "~a ~a"
+                            (slot-value base 'node-id)
+                            (slot-value base 'title)))))
+           (values
+             (print-fresh-node) ;ensure that data is correct when we start
+             (let ((base (car (clsql:select 'node
+                                :where [= 1 [slot-value 'node 'node-id]]
+                                :flatp t :caching nil))))
+               (setf (slot-value base 'title) "Altered title")
+               ;;modify and check
+               (clsql:update-records-from-instance base)
+               (print-fresh-node))
+             (let ((base (car (clsql:select 'node
+                                :where [= 1 [slot-value 'node 'node-id]]
+                                :flatp t :caching nil))))
+               (setf (slot-value base 'title) "Bare node")
+               ;;modify back to the original and check
+               (clsql:update-records-from-instance base)
+               (print-fresh-node))))
+         "1 Bare node"
+         "1 Altered title"
+         "1 Bare node")
+
+;;rewritten
+(deftest :oodml/update-records/4
+         (flet ((get-node ()
+                  (clsql:select 'node :where [= 1 [node-id]]
+                                :flatp t :caching nil)))
+           (with-dataset (*nodes*)
+             (values
+             (let ((base (get-node)))
+               (setf (slot-value base 'title) "Altered title")
+               (clsql:update-records-from-instance base)
+               (setf base (get-node))
+               (format nil "~a ~a"
+                            (slot-value base 'node-id)
+                            (slot-value base 'title))))))
+         "1 Altered title")