add %get-int to handle type-coersion to int and use it in generic-postgres

and throughout tests to simplify integer coersion, and allow
postgresql-socket3 to pass tests. (postgresql-socket3 always returns the
correct type, rather than sometimes returning strings)

diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp
index 1d1fbf07d62d8cb16a8862d35e0e5cde4a157f76..ecf6ddfde7ca2f404147c08aca113c95ec8e5e9a 100644 (file)
--- a/sql/generic-postgresql.lisp
+++ b/sql/generic-postgresql.lisp
@@ -177,28 +177,29 @@
                    database nil nil))))
     (when row
       (destructuring-bind (typname attlen atttypmod attnull) row
                    database nil nil))))
     (when row
       (destructuring-bind (typname attlen atttypmod attnull) row

-
-        (setf attlen (parse-integer attlen :junk-allowed t)
-              atttypmod (parse-integer atttypmod :junk-allowed t))
-
+        (setf attlen (%get-int attlen)
+              atttypmod (%get-int atttypmod))

         (let ((coltype (ensure-keyword typname))
         (let ((coltype (ensure-keyword typname))

-              (colnull (if (string-equal "f" attnull) 1 0))
+              (colnull (typecase attnull
+                         (string (if (string-equal "f" attnull) 1 0))
+                         (null 1)
+                         (T 0)))

               collen
               colprec)
               collen
               colprec)

-           (setf (values collen colprec)
-                 (case coltype
-                   ((:numeric :decimal)
-                    (if (= -1 atttypmod)
-                        (values nil nil)
-                        (values (ash (- atttypmod 4) -16)
-                                (boole boole-and (- atttypmod 4) #xffff))))
-                   (otherwise
-                    (values
-                     (cond ((and (= -1 attlen) (= -1 atttypmod)) nil)
-                           ((= -1 attlen) (- atttypmod 4))
-                           (t attlen))
-                     nil))))
-           (values coltype collen colprec colnull))))))
+          (setf (values collen colprec)
+                (case coltype
+                  ((:numeric :decimal)
+                   (if (= -1 atttypmod)
+                       (values nil nil)
+                       (values (ash (- atttypmod 4) -16)
+                               (boole boole-and (- atttypmod 4) #xffff))))
+                  (otherwise
+                   (values
+                    (cond ((and (= -1 attlen) (= -1 atttypmod)) nil)
+                          ((= -1 attlen) (- atttypmod 4))
+                          (t attlen))
+                    nil))))
+          (values coltype collen colprec colnull))))))

 
 (defmethod database-create-sequence (sequence-name
                                      (database generic-postgresql-database))
 
 (defmethod database-create-sequence (sequence-name
                                      (database generic-postgresql-database))


@@ -219,7 +220,7 @@
 (defmethod database-set-sequence-position (name (position integer)
                                                 (database generic-postgresql-database))
   (values
 (defmethod database-set-sequence-position (name (position integer)
                                                 (database generic-postgresql-database))
   (values

-   (parse-integer
+   (%get-int

     (caar
      (database-query
       (format nil "SELECT SETVAL ('~A', ~A)" (escaped-database-identifier name) position)
     (caar
      (database-query
       (format nil "SELECT SETVAL ('~A', ~A)" (escaped-database-identifier name) position)


@@ -228,7 +229,7 @@
 (defmethod database-sequence-next (sequence-name
                                    (database generic-postgresql-database))
   (values
 (defmethod database-sequence-next (sequence-name
                                    (database generic-postgresql-database))
   (values

-   (parse-integer
+   (%get-int

     (caar
      (database-query
       (concatenate 'string "SELECT NEXTVAL ('" (escaped-database-identifier sequence-name) "')")
     (caar
      (database-query
       (concatenate 'string "SELECT NEXTVAL ('" (escaped-database-identifier sequence-name) "')")


@@ -236,7 +237,7 @@
 
 (defmethod database-sequence-last (sequence-name (database generic-postgresql-database))
   (values
 
 (defmethod database-sequence-last (sequence-name (database generic-postgresql-database))
   (values

-   (parse-integer
+   (%get-int

     (caar
      (database-query
       (concatenate 'string "SELECT LAST_VALUE FROM " (escaped-database-identifier sequence-name))
     (caar
      (database-query
       (concatenate 'string "SELECT LAST_VALUE FROM " (escaped-database-identifier sequence-name))

diff --git a/sql/utils.lisp b/sql/utils.lisp
index b43e3180e64f6f8d392446229660c6eed1caaab1..34cd5dc8c4d5ae9a1daa8b533d9cf22dba3f091d 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -390,5 +390,4 @@ is replaced with replacement. [FROM http://cl-cookbook.sourceforge.net/strings.h
          when pos do (write-string replacement out)
            while pos)
     (unless stream
          when pos do (write-string replacement out)
            while pos)
     (unless stream

-      (get-output-stream-string out))))
-
+      (get-output-stream-string out))))
\ No newline at end of file

diff --git a/tests/package.lisp b/tests/package.lisp
index eca37bbb85aa01512b56ff9679977170ab1ef636..044aaccc1d7510875f21033a57c1f9370b9b8bfc 100644 (file)
--- a/tests/package.lisp
+++ b/tests/package.lisp
@@ -19,6 +19,7 @@
 
 (defpackage #:clsql-tests
   (:use #:clsql #:common-lisp #:rtest)
 
 (defpackage #:clsql-tests
   (:use #:clsql #:common-lisp #:rtest)

+  (:shadowing-import-from #:clsql-sys #:%get-int )

   (:export
    #:run-tests
    #:run-tests-append-report-file
   (:export
    #:run-tests
    #:run-tests-append-report-file

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index 74ed254e4d3acec47296a61202d2ec9314e22529..e9505b2788ba2f54fa8e8c9e79201c7cdce2a8b3 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -56,9 +56,7 @@
 (deftest :fdml/query/1
     (with-dataset *ds-employees*
       (let ((count (caar (clsql:query "SELECT COUNT(*) FROM EMPLOYEE WHERE (EMAIL LIKE '%org')" :field-names nil))))
 (deftest :fdml/query/1
     (with-dataset *ds-employees*
       (let ((count (caar (clsql:query "SELECT COUNT(*) FROM EMPLOYEE WHERE (EMAIL LIKE '%org')" :field-names nil))))

-       (if (stringp count)
-           (nth-value 0 (parse-integer count))
-           (nth-value 0 (truncate count)))))
+        (%get-int count)))

   10)
 
 (deftest :fdml/query/2
   10)
 
 (deftest :fdml/query/2


@@ -87,7 +85,7 @@
       (let ((res (clsql:query (clsql:sql [select [first-name] [sum [emplid]] :from [employee]]
                                         [group-by [first-name]] [order-by [sum [emplid]]])
                              :field-names nil :result-types nil)))
       (let ((res (clsql:query (clsql:sql [select [first-name] [sum [emplid]] :from [employee]]
                                         [group-by [first-name]] [order-by [sum [emplid]]])
                              :field-names nil :result-types nil)))

-       (mapcar (lambda (p) (list (car p) (truncate (read-from-string (second p)))))
+       (mapcar (lambda (p) (list (car p) (%get-int (second p))))

                res)))
   (("Josef" 2) ("Leon" 3) ("Nikita" 4) ("Leonid" 5) ("Yuri" 6)
    ("Konstantin" 7) ("Mikhail" 8) ("Boris" 9) ("Vladimir" 11)))
                res)))
   (("Josef" 2) ("Leon" 3) ("Nikita" 4) ("Leonid" 5) ("Yuri" 6)
    ("Konstantin" 7) ("Mikhail" 8) ("Boris" 9) ("Vladimir" 11)))


@@ -98,8 +96,9 @@
                                                [select [groupid] :from [company]]])
                              :field-names nil :result-types nil :flatp t
                              )))
                                                [select [groupid] :from [company]]])
                              :field-names nil :result-types nil :flatp t
                              )))

-       (values (every #'stringp res)
-               (sort (mapcar #'(lambda (f) (truncate (read-from-string f))) res)
+       (values (or (eql *test-database-type* :postgresql-socket3)
+                    (every #'stringp res))
+               (sort (mapcar #'%get-int res)

                      #'<=))))
   t (1 2 3 4 5 6 7 8 9 10))
 
                      #'<=))))
   t (1 2 3 4 5 6 7 8 9 10))
 


@@ -108,8 +107,9 @@
       (let ((res (car (clsql:query (clsql:sql [intersect [select [emplid] :from [employee]]
                                                         [select [groupid] :from [company]]])
                                   :field-names nil :result-types nil :flatp t))))
       (let ((res (car (clsql:query (clsql:sql [intersect [select [emplid] :from [employee]]
                                                         [select [groupid] :from [company]]])
                                   :field-names nil :result-types nil :flatp t))))

-       (values (stringp res)
-               (nth-value 0 (truncate (read-from-string res))))))
+       (values (or (stringp res)
+                    (eql *test-database-type* :postgresql-socket3))
+               (nth-value 0 (%get-int res)))))

   t 1)
 
 (deftest :fdml/query/8
   t 1)
 
 (deftest :fdml/query/8


@@ -117,12 +117,12 @@
       (let ((res (clsql:query (clsql:sql [except [select [emplid] :from [employee]]
                                                 [select [groupid] :from [company]]])
                              :field-names nil :result-types nil :flatp t)))
       (let ((res (clsql:query (clsql:sql [except [select [emplid] :from [employee]]
                                                 [select [groupid] :from [company]]])
                              :field-names nil :result-types nil :flatp t)))

-       (values (every #'stringp res)
-               (sort (mapcar #'(lambda (f) (truncate (read-from-string f))) res)
+       (values (or (every #'stringp res)
+                    (eql *test-database-type* :postgresql-socket3))
+               (sort (mapcar #'%get-int res)

                      #'<=))))
   t (2 3 4 5 6 7 8 9 10))
 
                      #'<=))))
   t (2 3 4 5 6 7 8 9 10))
 

-

 ;; compare min, max and average hieghts in inches (they're quite short
 ;; these guys!)
 (deftest :fdml/select/1
 ;; compare min, max and average hieghts in inches (they're quite short
 ;; these guys!)
 (deftest :fdml/select/1


@@ -142,8 +142,7 @@
                               :from [employee]
                               :result-types nil
                               :flatp t)))
                               :from [employee]
                               :result-types nil
                               :flatp t)))

-       (apply #'< (mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
-                          (append min avg max)))))
+       (apply #'< (mapcar #'%get-int (append min avg max)))))

   t)
 
 (deftest :fdml/select/2
   t)
 
 (deftest :fdml/select/2


@@ -162,7 +161,7 @@
                               :group-by [first-name]
                               :order-by [first-name]
                               :field-names nil)))
                               :group-by [first-name]
                               :order-by [first-name]
                               :field-names nil)))

-       (mapcar (lambda (p) (list (car p) (truncate (read-from-string (second p)))))
+       (mapcar (lambda (p) (list (car p) (%get-int (second p))))

                res)))
   (("Boris" 1) ("Josef" 1) ("Konstantin" 1) ("Leon" 1) ("Leonid" 1)
    ("Mikhail" 1) ("Nikita" 1) ("Vladimir" 2) ("Yuri" 1)))
                res)))
   (("Boris" 1) ("Josef" 1) ("Konstantin" 1) ("Leon" 1) ("Leonid" 1)
    ("Mikhail" 1) ("Nikita" 1) ("Vladimir" 2) ("Yuri" 1)))


@@ -189,12 +188,12 @@
 (deftest :fdml/select/6
     (with-dataset *ds-employees*
       (if (clsql-sys:db-type-has-fancy-math? *test-database-underlying-type*)
 (deftest :fdml/select/6
     (with-dataset *ds-employees*
       (if (clsql-sys:db-type-has-fancy-math? *test-database-underlying-type*)

-         (mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
+         (mapcar #'%get-int

                  (clsql:select [function "trunc" [height]] :from [employee]
                                :result-types nil
                                :field-names nil
                                :flatp t))
                  (clsql:select [function "trunc" [height]] :from [employee]
                                :result-types nil
                                :field-names nil
                                :flatp t))

-         (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t)))
+         (mapcar #'%get-int

                  (clsql:select [height] :from [employee] :flatp t
                                :field-names nil :result-types nil))))
   (1 1 1 1 1 1 1 1 1 1))
                  (clsql:select [height] :from [employee] :flatp t
                                :field-names nil :result-types nil))))
   (1 1 1 1 1 1 1 1 1 1))


@@ -204,27 +203,26 @@
       (let ((result (car (clsql:select [max [emplid]] :from [employee] :flatp t
                                       :field-names nil :result-types nil))))
        (values
       (let ((result (car (clsql:select [max [emplid]] :from [employee] :flatp t
                                       :field-names nil :result-types nil))))
        (values

-         (stringp result)
-         (nth-value 0 (truncate (read-from-string result))))))
-  t 10)
+         (nth-value 0 (%get-int result)))))
+  10)

 
 (deftest :fdml/select/8
     (with-dataset *ds-employees*
       (let ((result (car (clsql:select [min [emplid]] :from [employee] :flatp t
                                       :field-names nil :result-types nil))))
        (values
 
 (deftest :fdml/select/8
     (with-dataset *ds-employees*
       (let ((result (car (clsql:select [min [emplid]] :from [employee] :flatp t
                                       :field-names nil :result-types nil))))
        (values

-         (stringp result)
-         (nth-value 0 (truncate (read-from-string result))))))
-  t 1)
+         (nth-value 0 (%get-int result)))))
+  1)

 
 (deftest :fdml/select/9
 
 (deftest :fdml/select/9

-    (with-dataset *ds-employees*
-      (subseq
-       (car
-       (clsql:select [avg [emplid]] :from [employee] :flatp t
-                     :field-names nil :result-types nil))
-       0 3))
-  "5.5")
+ (with-dataset *ds-employees*
+   (let ((val (car (clsql:select
+                       [avg [emplid]] :from [employee] :flatp t
+                       :field-names nil :result-types nil))))
+     (typecase val
+       (string (subseq val 0 3))
+       (number (format nil "~,1F" val)))))
+ "5.5")

 
 (deftest :fdml/select/10
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/10
     (with-dataset *ds-employees*


@@ -297,18 +295,21 @@
   (("1" "Lenin")))
 
 (deftest :fdml/select/19
   (("1" "Lenin")))
 
 (deftest :fdml/select/19

-    (with-dataset *ds-employees*
-      (clsql:select [emplid] :from [employee] :order-by [emplid]
-                   :where [between [* [emplid] 10] [* 5 10] [* 10 10]]
-                   :field-names nil :result-types nil :flatp t))
-  ("5" "6" "7" "8" "9" "10"))
+ (with-dataset *ds-employees*
+   (mapcar
+    #'%get-int
+    (clsql:select [emplid] :from [employee] :order-by [emplid]
+                  :where [between [* [emplid] 10] [* 5 10] [* 10 10]]
+                  :field-names nil :result-types nil :flatp t)))
+ (5 6 7 8 9 10))

 
 (deftest :fdml/select/20
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/20
     (with-dataset *ds-employees*

+      (mapcar #'%get-int

       (clsql:select [emplid] :from [employee] :order-by [emplid]
                    :where [not [between [* [emplid] 10] [* 5 10] [* 10 10]]]
       (clsql:select [emplid] :from [employee] :order-by [emplid]
                    :where [not [between [* [emplid] 10] [* 5 10] [* 10 10]]]

-                   :field-names nil :result-types nil :flatp t))
-  ("1" "2" "3" "4"))
+                   :field-names nil :result-types nil :flatp t)))
+  (1 2 3 4))

 
 (deftest :fdml/select/21
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/21
     (with-dataset *ds-employees*


@@ -328,11 +329,12 @@
    "Boris Yeltsin" "Vladimir Putin"))
 
 (deftest :fdml/select/23
    "Boris Yeltsin" "Vladimir Putin"))
 
 (deftest :fdml/select/23

-    (with-dataset *ds-employees*
-      (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
-                   :flatp t :order-by [emplid] :field-names nil
-                   :result-types nil))
-  ("1" "2" "3" "4"))
+ (with-dataset *ds-employees*
+   (mapcar #'%get-int
+           (clsql:select [emplid] :from [employee] :where [in [emplid] '(1 2 3 4)]
+                         :flatp t :order-by [emplid] :field-names nil
+                         :result-types nil)))
+ (1 2 3 4))

 
 (deftest :fdml/select/24
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/24
     (with-dataset *ds-employees*


@@ -366,19 +368,20 @@
 (deftest :fdml/select/27
     (with-dataset *ds-employees*
       (mapcar
 (deftest :fdml/select/27
     (with-dataset *ds-employees*
       (mapcar

-       (lambda (f) (truncate (read-from-string f)))
+       #'%get-int

        (clsql:select [coalesce [managerid] 10] :from [employee] :order-by [emplid]
                     :field-names nil :result-types nil :flatp t)))
   (10 1 1 1 1 1 1 1 1 1))
 
 (deftest :fdml/select/28
        (clsql:select [coalesce [managerid] 10] :from [employee] :order-by [emplid]
                     :field-names nil :result-types nil :flatp t)))
   (10 1 1 1 1 1 1 1 1 1))
 
 (deftest :fdml/select/28

-    (with-dataset *ds-employees*
-      (mapcar
-       (lambda (f) (truncate (read-from-string (car f))))
-       (loop for column in `([*] [emplid]) collect
-        (clsql:select [count column] :from [employee]
-              :flatp t :result-types nil :field-names nil))))
-  (10 10))
+ (with-dataset *ds-employees*
+   (loop for column in `([*] [emplid])
+         collect
+         (%get-int
+          (car
+           (clsql:select [count column] :from [employee]
+                         :flatp t :result-types nil :field-names nil)))))
+ (10 10))

 
 (deftest :fdml/select/29
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/29
     (with-dataset *ds-employees*


@@ -414,10 +417,12 @@
 
 (deftest :fdml/select/32
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/32
     (with-dataset *ds-employees*

-      (clsql:select [emplid] :from [employee]
-                   :where [= [emplid] [any [select [companyid] :from [company]]]]
-                   :flatp t :result-types nil :field-names nil))
-  ("1"))
+      (mapcar
+       #'%get-int
+       (clsql:select [emplid] :from [employee]
+                     :where [= [emplid] [any [select [companyid] :from [company]]]]
+                     :flatp t :result-types nil :field-names nil)))
+  (1))

 
 (deftest :fdml/select/33
     (with-dataset *ds-employees*
 
 (deftest :fdml/select/33
     (with-dataset *ds-employees*

diff --git a/tests/utils.lisp b/tests/utils.lisp
index 95c97172c941b782fe5f4f47381deed1fcfb8e0b..396e3030f629e99ae7e0f076b8756d7c1fc2ae93 100644 (file)
--- a/tests/utils.lisp
+++ b/tests/utils.lisp
@@ -16,6 +16,12 @@
 
 (in-package #:clsql-tests)
 
 
 (in-package #:clsql-tests)
 

+(defun %get-int (v)
+  (etypecase v
+    (string (parse-integer v :junk-allowed t))
+    (integer v)
+    (number (truncate v))))
+

 (defvar *config-pathname*
   (make-pathname :defaults (user-homedir-pathname)
                  :name ".clsql-test"
 (defvar *config-pathname*
   (make-pathname :defaults (user-homedir-pathname)
                  :name ".clsql-test"