tests/datasets.lisp

   1 ;;;; Proposed new file in clsql-tests to enable abstracting datasets for reuse.
   2 ;;;;
   3 ;;;; The core is def-datset and with-dataset that respectively define a set,
   4 ;;;; and enable one for a dynamic scope. Datasets will normally be setup and
   5 ;;;; torn down in the scope of one test, which may impose a computation
   6 ;;;; overhead, but enables simpler tests by not worrying about side-effects
   7 ;;;; between tests.
   8 ;;;;
   9 ;;;; In general datsets should be database agnostic, but because the code
  10 ;;;; is only run in the scope of a test, if a test is excluded for a backend
  11 ;;;; or some other reason then it is never run hence doesn't cause problems.
  12
  13 (in-package #:clsql-tests)
  14
  15 (defmacro def-dataset (name &body body)
  16   "Define a dataset"
  17   ;;probably just shove this into a param, perhaps a marginal
  18   ;; bit of processing first.
  19   `(defparameter ,name ',body))
  20
  21 ;;incomplete example taken from test-init
  22 (def-dataset *employees*
  23   (:setup "CREATE TABLE EMPLOYEES (
  24 emplid int not null,
  25 groupid int not null,
  26 married boolean not null,
  27 first_name varchar (50),
  28 last_name varchar (50))" ))
  29 ;;alternatively setup can still be done as
  30 ;;(:setup #'(lambda () (create-view-from-class ...)))
  31   (:data "employees"
  32    (:columns "emplid,groupid,married,height,first_name,last_name")
  33    (:values "1,1,false,1.5,'Napolean', 'Bonaparte'")
  34    (:values (format nil "1,1,true,~a,'Vladimir','Lenin'" (1+ (random 1.00)))))
  35   (:cleanup "DROP TABLE EMPLOYEES"))
  36
  37
  38 (defmacro with-dataset (name &body body)
  39   "Use a dataset in a dynamic scope, e.g. a single test.
  40 1. Before the body:
  41   * :setup is run
  42   * :data is loaded
  43 2. Body
  44 3. :cleanup always happens"
  45   `(unwind-protect
  46         (progn (%dataset-init ,name)
  47                ,@body)
  48      (handler-case (%dataset-cleanup ,name)
  49        (error #'print-the-error)) ;;recursive error catch
  50      ))
  51
  52
  53 (defun %dataset-dispatch (arg)
  54   "For use with def-dataset and with-dataset, tries to DWIM."
  55   (etypecase arg
  56     (string (clsql-sys:execute-command arg))  ;;treat it as a sql command.
  57     ((or function symbol) (funcall fn))  ;;run functions
  58     (list (mapc #'%dataset-dispatch arg)))) ;;lists are implicity progn
  59
  60 (defun %dataset-init (name)
  61   "Run initialization code and fill database for given dataset."
  62   (let ((setup (find :setup name :key #'first))
  63         (data (find :data name :key #'first)))
  64     (when setup
  65       (%dataset-dispatch setup))
  66     (when data
  67       ;;run raw sql insert statements,
  68       ;; other schemes can be done as a function in setup.
  69       ;; most likely implemented with something like
  70       (let (table-name columns values-list) ;gather components
  71         (dolist (v values-list)
  72           (clsql-sys:execute-command
  73            (format nil "INSERT INTO ~a (~a) VALUES (~a)"
  74                    table-name columns v)))))))
  75
  76 (defun %dataset-cleanup (name)
  77   "Run cleanup code associated with the given dataset."
  78   (%dataset-dispatch (find :cleanup name)))
  79
  80
  81 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82 ;;; Example Test Code
  83
  84 ;;example old test
  85 (deftest :oodml/select/1
  86     (mapcar #'(lambda (e) (slot-value e 'last-name))
  87             (clsql:select 'employee :order-by [last-name] :flatp t :caching nil))
  88   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
  89               "Stalin" "Trotsky" "Yeltsin"))
  90
  91 ;;just wrap in the with-dataset
  92 (deftest :oodml/select/1
  93     (with-dataset (*employees*)
  94       (mapcar #'(lambda (e) (slot-value e 'last-name))
  95               (clsql:select 'employee :order-by [last-name]
  96                             :flatp t :caching nil)))
  97   ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
  98               "Stalin" "Trotsky" "Yeltsin"))
  99
 100
 101 ;;old
 102 (deftest :oodml/update-records/4
 103           (flet ((print-fresh-node ()
 104                    (let ((base (car (clsql:select 'node
 105                                       :where [= 1 [slot-value 'node 'node-id]]
 106                                       :flatp t :caching nil))))
 107                      (format nil "~a ~a"
 108                              (slot-value base 'node-id)
 109                              (slot-value base 'title)))))
 110             (values
 111               (print-fresh-node) ;ensure that data is correct when we start
 112               (let ((base (car (clsql:select 'node
 113                                  :where [= 1 [slot-value 'node 'node-id]]
 114                                  :flatp t :caching nil))))
 115                 (setf (slot-value base 'title) "Altered title")
 116                 ;;modify and check
 117                 (clsql:update-records-from-instance base)
 118                 (print-fresh-node))
 119               (let ((base (car (clsql:select 'node
 120                                  :where [= 1 [slot-value 'node 'node-id]]
 121                                  :flatp t :caching nil))))
 122                 (setf (slot-value base 'title) "Bare node")
 123                 ;;modify back to the original and check
 124                 (clsql:update-records-from-instance base)
 125                 (print-fresh-node))))
 126           "1 Bare node"
 127           "1 Altered title"
 128           "1 Bare node")
 129
 130 ;;rewritten
 131 (deftest :oodml/update-records/4
 132           (flet ((get-node ()
 133                    (clsql:select 'node :where [= 1 [node-id]]
 134                                  :flatp t :caching nil)))
 135             (with-dataset (*nodes*)
 136               (values
 137               (let ((base (get-node)))
 138                 (setf (slot-value base 'title) "Altered title")
 139                 (clsql:update-records-from-instance base)
 140                 (setf base (get-node))
 141                 (format nil "~a ~a"
 142                              (slot-value base 'node-id)
 143                              (slot-value base 'title))))))
 144           "1 Altered title")