1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
;;;; 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 datasets 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)
(defparameter *dataset-debug-on-error* nil
"If we get an error while loading or cleaning up the dataset,
should we debug (T) or just print and quit.")
(defun generic-error (e)
(when (and *dataset-debug-on-error*
*debugger-hook*)
(invoke-debugger e))
(fresh-line *error-output*)
(princ e *error-output*)
(throw 'quit-dataset e))
(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))
(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"
`(catch 'quit-dataset
(unwind-protect
(progn
(restart-case (%dataset-init ,name)
(retry-dataset-init ()
:report ,(format nil "Retry dataset('~a) init: (with any dataset changes)"
(symbol-name name))
(%dataset-init ,name))
(skip-this-test ()
:report "FAIL and run the next test"
(throw 'quit-dataset :data-set-failure)))
,@body)
(%dataset-cleanup ,name))))
(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 arg)) ;run functions
(list
(case (first arg)
((function lambda) (%dataset-dispatch (eval arg))) ;#' forms, lambdas
(progn (mapc #'%dataset-dispatch (rest arg))) ; (progn "asdf" "ff")
(ignore-errors (ignore-errors (mapc #'%dataset-dispatch (rest arg))))
(t (mapc #'%dataset-dispatch arg))) ;otherwise implicit progn
)))
(defun %dataset-init (name)
"Run initialization code and fill database for given dataset."
;;find items that looks like '(:setup ...),
;; dispatch the rest.
(let ((*backend-warning-behavior*
(typecase *default-database*
(clsql-sys:generic-postgresql-database
:ignore)
(t *backend-warning-behavior*)))
(setup (rest (find :setup name :key #'first)))
(sqldata (rest (find :sqldata name :key #'first)))
(objdata (rest (find :objdata name :key #'first))))
(when setup
(handler-bind ((warning
(lambda (c)
(when (eql :ignore *backend-warning-behavior*)
(muffle-warning c)))))
(%dataset-dispatch setup)))
(when sqldata
;;run raw sql insert statements
(destructuring-bind (table-name columns &rest values-list) sqldata
(dolist (v values-list)
(clsql-sys:execute-command
(format nil
"INSERT INTO ~a (~a) VALUES (~a)"
table-name columns v)))))
(when objdata
;;presumed to be view-class objects, force them to insert.
(dolist (o objdata)
(setf (slot-value o 'clsql-sys::view-database) nil)
(clsql-sys:update-records-from-instance o)))))
(defun %dataset-cleanup (name)
"Run cleanup code associated with the given dataset."
(restart-case
(handler-bind ((error #'generic-error))
(let ((cleanup (rest (find :cleanup name :key #'first))))
(when cleanup
(%dataset-dispatch cleanup))))
(retry-dataset-cleanup ()
:report "Retry dataset cleanup (with any dataset changes)"
(%dataset-cleanup name))
(skip-cleanup () nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example Test Code
;;incomplete example taken from test-init
;; (def-dataset *employees*
;; (:setup "CREATE TABLE employee
;; (
;; emplid integer NOT NULL,
;; groupid integer NOT NULL,
;; first_name character varying(30),
;; last_name character varying(30),
;; email character varying(100),
;; ecompanyid integer,
;; managerid integer,
;; height double,
;; married boolean,
;; birthday timestamp without time zone,
;; bd_utime bigint,
;; CONSTRAINT employeepk PRIMARY KEY (emplid, groupid),
;; CONSTRAINT employee_emplid_key UNIQUE (emplid)
;; )
;; ")
;; ;;alternatively setup can still be done as
;; ;;(:setup #'(lambda () (create-view-from-class ...)))
;; (:sqldata "employees" "emplid,groupid,married,height,first_name,last_name"
;; "1,1,false,1.5,'Napolean', 'Bonaparte'"
;; (format nil "1,1,true,~a,'Vladimir','Lenin'" (1+ (random 1.00))))
;; (:cleanup "DROP TABLE EMPLOYEES"))
|
