X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Fdatasets.lisp;h=42698ec924a313c8564999b74efc1be5c940c699;hp=114deaccccafe2a0becbba14dbe05d06515c4946;hb=0b35694f3659e5ee739ea72ce74d798c3f0ddb73;hpb=4f42e6bf168107ce0ffd9ed0ca0316d00301b11d

diff --git a/tests/datasets.lisp b/tests/datasets.lisp
index 114deac..42698ec 100644
--- a/tests/datasets.lisp
+++ b/tests/datasets.lisp
@@ -20,7 +20,8 @@ should we debug (T) or just print and quit.")
   (when (and *dataset-debug-on-error*
 	     *debugger-hook*)
     (invoke-debugger e))
-  (print e *error-output*)
+  (fresh-line *error-output*)
+  (princ e *error-output*)
   (throw 'quit-dataset e))
 
 (defmacro def-dataset (name &body body)
@@ -43,7 +44,10 @@ should we debug (T) or just print and quit.")
 	      (retry-dataset-init ()
 		:report ,(format nil "Retry dataset('~a) init: (with any dataset changes)"
 				(symbol-name name))
-		(%dataset-init ,name)))
+		(%dataset-init ,name))
+	      (skip-this-test ()
+		:report "FAIL and run the next test"
+		(throw 'quit-dataset :data-set-failure)))
 	    ,@body)
        (%dataset-cleanup ,name))))
 
@@ -63,32 +67,39 @@ should we debug (T) or just print and quit.")
 
 (defun %dataset-init (name)
   "Run initialization code and fill database for given dataset."
-      (handler-bind
-	  ((error #'generic-error))
-	;;find items that looks like '(:setup ...),
-	;; dispatch the rest.
-	(let ((setup (rest (find :setup name :key #'first)))
-	      (sqldata (rest (find :sqldata name :key #'first)))
-	      (objdata (rest (find :objdata name :key #'first))))
-	  (when setup
-	    (%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))))))
+  ;;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 
+  (restart-case
       (handler-bind ((error #'generic-error))
 	(let ((cleanup (rest (find :cleanup name :key #'first))))
 	  (when cleanup