1 ;;;; Proposed new file in clsql-tests to enable abstracting datasets for reuse.
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
9 ;;;; In general datasets 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.
13 (in-package #:clsql-tests)
15 (defparameter *dataset-debug-on-error* nil
16 "If we get an error while loading or cleaning up the dataset,
17 should we debug (T) or just print and quit.")
19 (defun generic-error (e)
20 (when (and *dataset-debug-on-error*
23 (fresh-line *error-output*)
24 (princ e *error-output*)
25 (throw 'quit-dataset e))
27 (defmacro def-dataset (name &body body)
29 ;;probably just shove this into a param, perhaps a marginal
30 ;; bit of processing first.
31 `(defparameter ,name ',body))
33 (defmacro with-dataset (name &body body)
34 "Use a dataset in a dynamic scope, e.g. a single test.
39 3. :cleanup always happens"
43 (restart-case (%dataset-init ,name)
44 (retry-dataset-init ()
45 :report ,(format nil "Retry dataset('~a) init: (with any dataset changes)"
47 (%dataset-init ,name))
49 :report "FAIL and run the next test"
50 (throw 'quit-dataset :data-set-failure)))
52 (%dataset-cleanup ,name))))
55 (defun %dataset-dispatch (arg)
56 "For use with def-dataset and with-dataset, tries to DWIM."
58 (string (clsql-sys:execute-command arg)) ;treat it as a sql command.
59 ((or function symbol) (funcall arg)) ;run functions
62 ((function lambda) (%dataset-dispatch (eval arg))) ;#' forms, lambdas
63 (progn (mapc #'%dataset-dispatch (rest arg))) ; (progn "asdf" "ff")
64 (ignore-errors (ignore-errors (mapc #'%dataset-dispatch (rest arg))))
65 (t (mapc #'%dataset-dispatch arg))) ;otherwise implicit progn
68 (defun %dataset-init (name)
69 "Run initialization code and fill database for given dataset."
70 ;;find items that looks like '(:setup ...),
72 (let ((*backend-warning-behavior*
73 (typecase *default-database*
74 (clsql-sys:generic-postgresql-database
76 (t *backend-warning-behavior*)))
77 (setup (rest (find :setup name :key #'first)))
78 (sqldata (rest (find :sqldata name :key #'first)))
79 (objdata (rest (find :objdata name :key #'first))))
81 (handler-bind ((warning
83 (when (eql :ignore *backend-warning-behavior*)
84 (muffle-warning c)))))
85 (%dataset-dispatch setup)))
87 ;;run raw sql insert statements
88 (destructuring-bind (table-name columns &rest values-list) sqldata
89 (dolist (v values-list)
90 (clsql-sys:execute-command
92 "INSERT INTO ~a (~a) VALUES (~a)"
93 table-name columns v)))))
95 ;;presumed to be view-class objects, force them to insert.
97 (setf (slot-value o 'clsql-sys::view-database) nil)
98 (clsql-sys:update-records-from-instance o)))))
100 (defun %dataset-cleanup (name)
101 "Run cleanup code associated with the given dataset."
103 (handler-bind ((error #'generic-error))
104 (let ((cleanup (rest (find :cleanup name :key #'first))))
106 (%dataset-dispatch cleanup))))
107 (retry-dataset-cleanup ()
108 :report "Retry dataset cleanup (with any dataset changes)"
109 (%dataset-cleanup name))
110 (skip-cleanup () nil)))
113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
114 ;;; Example Test Code
116 ;;incomplete example taken from test-init
117 ;; (def-dataset *employees*
118 ;; (:setup "CREATE TABLE employee
120 ;; emplid integer NOT NULL,
121 ;; groupid integer NOT NULL,
122 ;; first_name character varying(30),
123 ;; last_name character varying(30),
124 ;; email character varying(100),
125 ;; ecompanyid integer,
126 ;; managerid integer,
129 ;; birthday timestamp without time zone,
131 ;; CONSTRAINT employeepk PRIMARY KEY (emplid, groupid),
132 ;; CONSTRAINT employee_emplid_key UNIQUE (emplid)
135 ;; ;;alternatively setup can still be done as
136 ;; ;;(:setup #'(lambda () (create-view-from-class ...)))
137 ;; (:sqldata "employees" "emplid,groupid,married,height,first_name,last_name"
138 ;; "1,1,false,1.5,'Napolean', 'Bonaparte'"
139 ;; (format nil "1,1,true,~a,'Vladimir','Lenin'" (1+ (random 1.00))))
140 ;; (:cleanup "DROP TABLE EMPLOYEES"))