added test for log database (Against sqlite3)

clsql-helper.asd

@@ -49,6 +49,12 @@
 
 (defmethod asdf:perform ((o asdf:test-op) (c (eql (find-system :clsql-helper))))
   (asdf:load-system :clsql-helper-test)
+
+  ;; this is just so we can test stuff that requires a db connection
+  ;; not really a big deal if it fails, we will just skip a couple of tests
+  (when (ignore-errors (asdf:load-system :clsql-sqlite3))
+    (pushnew :clsql-sqlite3 *features*))
+
   (let ((*package* (find-package :clsql-helper-test)))
     (eval (read-from-string "(run-tests)"))))
 

clsql.lisp

@@ -70,7 +70,7 @@
 (defun table-name-string ( table-name )
   (clsql-sys:sql (table-name-exp table-name)))
 
-(defun column-name-exp (column)
+(defun column-name-exp ( column )
   (typecase column
     (symbol (column-name-exp (symbol-munger:lisp->underscores column)))
     (string (make-instance 'clsql-sys:sql-ident :name column ))
@@ -240,7 +240,7 @@
   "prints a correctly sql escaped value for postgres"
   (etypecase d
     (null (format stream "null"))
-    (string (format stream "'~a'" (clsql-sys:sql-escape-quotes d)))
+    (string (format stream "~a" (db-string d)))
     (integer (format stream "~D" d))
     (float (format stream "~F" d))
     (clsql-sys:date (format stream "'~a'" (iso8601-datestamp d)))

date.lisp

@@ -31,6 +31,10 @@
   (when (find-package :local-time)
     (pushnew :local-time *features*)))
 
+;; Put clsql into the features list so that we can
+;; conditionally compile things based on this
+(pushnew :clsql *features*)
+
 (in-package :clsql-helper)
 (cl-interpol:enable-interpol-syntax)
 (clsql:file-enable-sql-reader-syntax)

tests/clsql.lisp

@@ -151,4 +151,36 @@
   )
 
 
+#+clsql-sqlite3
+(progn
+ (defparameter +test-db+
+   (princ-to-string
+    (asdf:system-relative-pathname :clsql-helper "tests/test.sqlite3")))
+
+ (defmacro with-test-db (()&body body)
+   `(clsql-sys:with-database
+     (clsql-sys:*default-database*
+      (list +test-db+) :database-type :sqlite3)
+     ,@body))
+
+ (defvar *log* t)
+ (defun sql-log (str &rest args)
+   (apply #'format *log* str args))
+
+ (define-test log-test
+   (assert-true
+       (search
+        "
+ SELECT id, name
+   FROM test
+   WHERE ID=1"
+        (with-output-to-string (*log*)
+          (with-test-db ()
+            (log-database-command (sql-log)
+              (clsql:query "SELECT id, name FROM test WHERE ID=1"))))
+        :test #'string-equal))
+   ))
+
+
+
 (run-tests)

tests/set-slot-value-using-class.lisp

@@ -0,0 +1,86 @@
+(defpackage :clsql-helper-slot-coercer-test
+  (:use :cl :clsql-helper :lisp-unit :iter))
+
+(in-package :clsql-helper-slot-coercer-test)
+(cl-interpol:enable-interpol-syntax)
+
+(clsql-sys:def-view-class role ()
+    ((name :column first_name :accessor name
+           :db-constraints nil :initform nil :type clsql-sys:varchar
+           :initarg name)
+     (id :column id :accessor id :db-kind key :db-constraints
+         (not-null) :type integer :initarg id)))
+
+(clsql-sys:def-view-class user ()
+    ((date-entered :column date_entered :accessor date-entered
+                   :db-constraints nil :type clsql-sys:wall-time :initarg
+                   date-entered)
+     (edate :column edate :accessor edate
+            :db-constraints nil :type clsql-sys:date :initarg
+            edate)
+
+     (amount :column amount :accessor amount
+            :db-constraints nil :type double-float :initarg
+            edate)
+     (deleted :column deleted :accessor deleted :db-constraints nil
+              :type boolean :initarg deleted)
+     (email :column email :accessor email :db-constraints (not-null)
+            :type (clsql-sys:varchar 128) :initarg email)
+     (enabled :column enabled :accessor enabled :db-constraints
+              (not-null) :initform t :type boolean :initarg enabled)
+     (first-name :column first_name :accessor first-name
+                 :db-constraints nil :initform nil :type clsql-sys:varchar
+                 :initarg first-name)
+     (id :column id :accessor id :db-kind key :db-constraints
+         (not-null) :type integer :initarg id)
+     (last-name :column last_name :accessor last-name :db-constraints
+                nil :initform nil :type clsql-sys:varchar :initarg last-name)
+     (password :column password :accessor password :db-constraints
+               (not-null) :type (clsql-sys:varchar 32) :initarg password)
+     (role-id :column role_id :accessor role-id :db-constraints
+              (not-null) :type integer :initarg role-id)
+     (role-join :accessor role-join :db-kind join :db-info
+                (:join-class role :home-key role-id :foreign-key id
+                                 :set nil))
+     (salt :column salt :accessor salt :db-constraints (not-null) :type
+           (clsql-sys:varchar 4) :initarg salt))
+ (base-table users))
+
+(define-test test-slot-value-coersion
+  (let ((u (make-instance 'user)))
+    (setf (first-name u) "First" )
+    (assert-true (stringp (first-name u)))
+    (setf (last-name u) :Last )
+    (assert-true (stringp (last-name u)))
+    (setf (role-id u) "47")
+    (assert-true (typep (role-id u) 'integer))
+
+    (setf (date-entered u) "7/7/1977 11:43:26.123456")
+    (assert-true (typep (date-entered u) 'clsql-sys:wall-time) (date-entered u))
+    (setf (date-entered u) (convert-to-clsql-date "7/7/1977 11:43:26.123456"))
+    (assert-true (typep (date-entered u) 'clsql-sys:wall-time) (date-entered u))
+    (setf (date-entered u) (convert-to-clsql-datetime "7/7/1977 11:43:26.123456"))
+    (assert-true (typep (date-entered u) 'clsql-sys:wall-time) (date-entered u))
+    (setf (date-entered u) nil)
+    (assert-true (typep (date-entered u) 'null) (date-entered u))
+    (assert-error 'error (setf (date-entered u) "asdf"))
+
+    (setf (edate u) nil)
+    (assert-true (typep (edate u) 'null) (edate u))
+    (setf (edate u) "7/7/1977")
+    (assert-true (typep (edate u) 'clsql-sys:date) (edate u))
+    (setf (edate u) (convert-to-clsql-datetime "7/7/1977"))
+    (assert-true (typep (edate u) 'clsql-sys:date) (edate u))
+    (assert-error 'error (setf (edate u) "asdf"))
+
+    (setf (amount u) 23)
+    (assert-true (typep (amount u) 'double-float) (amount u))
+    (setf (amount u) "23")
+    (assert-true (typep (amount u) 'double-float) (amount u))
+    (setf (amount u) 23.2)
+    (assert-true (typep (amount u) 'double-float) (amount u))
+    (setf (amount u) 23.2d0)
+    (assert-true (typep (amount u) 'double-float) (amount u))
+    ))
+
+(run-tests)