Re: unsigned 64 bit integers patch

Aaron Burrow <[email protected]> Tue, 7 Jan 2014 01:03:59 -0500
Newsgroups gmane.lisp.clsql.general
Message-ID <CADExsvHfcQ=OUuthKp_9GfSv-Rcg9XgyVXTUyjnJRACgYZ=iOg@mail.gmail.com>
Here is an updated patch with a test case.

diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp
index 24129e6..f9f1532 100644
--- a/tests/test-basic.lisp
+++ b/tests/test-basic.lisp
@@ -226,6 +226,21 @@
                        "mismatch on randomized bigtext(~a) inserted:
~s returned: ~s" len str a))
              ))))
      nil)
+    (deftest :basic/reallybigintegers/1
+      (with-dataset *ds-reallybigintegers*
+        (let ((a (1- (expt 2 64)))
+              (b (- (expt 2 64) 2))
+              (c (expt 2 63))
+              (d (expt 2 62)))
+          (query
+            (format nil "INSERT INTO testreallybigintegers
+                              VALUES (~A, ~A, ~A, ~A)"
+                        a b c d))
+          (let ((results
+                  (query
+                    (format nil "SELECT * FROM testreallybigintegers"))))
+            (equal `(,a ,b ,c ,d) (car results)))))
+      t)
     ))


@@ -285,3 +300,14 @@
 (def-dataset *ds-bigtext*
   (:setup "CREATE TABLE testbigtext(a varchar(7500))")
   (:cleanup "DROP TABLE testbigtext"))
+
+(def-dataset *ds-reallybigintegers*
+  (:setup (lambda ()
+            (ignore-errors
+              (clsql:execute-command "DROP TABLE testreallybigintegers"))
+            (clsql:execute-command
+              "CREATE TABLE testreallybigintegers(a BIGINT UNSIGNED,
+                                                  b BIGINT UNSIGNED,
+                                                  c BIGINT UNSIGNED,
+                                                  d BIGINT UNSIGNED)")))
+  (:cleanup "DROP TABLE testreallybigintegers"))
diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
index 79d423f..942c69d 100644
--- a/uffi/clsql-uffi.lisp
+++ b/uffi/clsql-uffi.lisp
@@ -71,6 +71,18 @@
      (radix :int))
   :returning :unsigned-long)

+(uffi:def-function ("strtoull" c-strtoull)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :unsigned-long-long)
+
+(uffi:def-function ("strtoll" c-strtoll)
+    ((str (* :unsigned-char))
+     (endptr (* :unsigned-char))
+     (radix :int))
+  :returning :unsigned-long-long)
+
 (uffi:def-function "atol"
     ((str (* :unsigned-char)))
   :returning :long)
@@ -108,6 +120,16 @@
            (type char-ptr-def char-ptr))
   (c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))

+(defun strtoull (char-ptr)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (c-strtoull char-ptr uffi:+null-cstring-pointer+ 10))
+
+(defun strtoll (char-ptr)
+  (declare (optimize (speed 3) (safety 0) (space 0))
+           (type char-ptr-def char-ptr))
+  (c-strtoll char-ptr uffi:+null-cstring-pointer+ 10))
+
 (defun convert-raw-field (char-ptr type &key length encoding)
  (declare (optimize (speed 3) (safety 0) (space 0))
           (type char-ptr-def char-ptr))
@@ -122,17 +144,14 @@
        (atol char-ptr))
       (:int32
        (atoi char-ptr))
+      (:int64
+       (strtoll char-ptr))
       (:uint32
        (strtoul char-ptr))
       (:uint
        (strtoul char-ptr))
-      ((:int64 :uint64)
-       (uffi:with-foreign-object (high32-ptr :unsigned-int)
-         (let ((low32 (atol64 char-ptr high32-ptr))
-               (high32 (uffi:deref-pointer high32-ptr :unsigned-int)))
-           (if (zerop high32)
-               low32
-               (make-64-bit-integer high32 low32)))))
+      (:uint64
+       (strtoull char-ptr))
       (:blob
        (if length
            (uffi:convert-from-foreign-usb8 char-ptr length)


On Mon, Jan 6, 2014 at 11:49 PM, Aaron Burrow <[email protected]> wrote:
> I do not believe unsigned 64 bit integers behave properly.
>
> CL-USER> (setf d (clsql:connect '("127.0.0.1" "dt0" "root" "letmein" 3306)
>                                 :database-type :mysql
>                                 :if-exists :new
>                                 :make-default nil))
>  <snip>
> #<CLSQL-MYSQL:MYSQL-DATABASE 127.0.0.1:3306/dt0/root OPEN {10068A59C3}>
> CL-USER> (clsql:query "create table tt (x bigint unsigned)" :database d)
> NIL
> NIL
> CL-USER> (clsql:query "select * from tt" :database d)
> NIL
> ("x")
> CL-USER> (clsql:query (format nil "insert into tt values (~A), (~A), (~A)"
>                              (expt 2 64) (1- (expt 2 64)) (expt 2 63))
>                       :database d)
> NIL
> NIL
> CL-USER> (clsql:query "select * from tt" :database d)
> ((-1) (-1) (-9223372036854775808))
> ("x")
>
> The issue seemed to stem from indiscriminately using
> make-64-bit-integer(...) which was treating everything like it was signed.
> My patch uses strtoull and strtoll in an attempt to match the style seen
> nearby.  Why do you not use parse-integer(...) ?
>
> patch:
>
> diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp
> index 79d423f..942c69d 100644
> --- a/uffi/clsql-uffi.lisp
> +++ b/uffi/clsql-uffi.lisp
> @@ -71,6 +71,18 @@
>       (radix :int))
>    :returning :unsigned-long)
>
> +(uffi:def-function ("strtoull" c-strtoull)
> +    ((str (* :unsigned-char))
> +     (endptr (* :unsigned-char))
> +     (radix :int))
> +  :returning :unsigned-long-long)
> +
> +(uffi:def-function ("strtoll" c-strtoll)
> +    ((str (* :unsigned-char))
> +     (endptr (* :unsigned-char))
> +     (radix :int))
> +  :returning :unsigned-long-long)
> +
>  (uffi:def-function "atol"
>      ((str (* :unsigned-char)))
>    :returning :long)
> @@ -108,6 +120,16 @@
>             (type char-ptr-def char-ptr))
>    (c-strtoul char-ptr uffi:+null-cstring-pointer+ 10))
>
> +(defun strtoull (char-ptr)
> +  (declare (optimize (speed 3) (safety 0) (space 0))
> +           (type char-ptr-def char-ptr))
> +  (c-strtoull char-ptr uffi:+null-cstring-pointer+ 10))
> +
> +(defun strtoll (char-ptr)
> +  (declare (optimize (speed 3) (safety 0) (space 0))
> +           (type char-ptr-def char-ptr))
> +  (c-strtoll char-ptr uffi:+null-cstring-pointer+ 10))
> +
>  (defun convert-raw-field (char-ptr type &key length encoding)
>   (declare (optimize (speed 3) (safety 0) (space 0))
>            (type char-ptr-def char-ptr))
> @@ -122,17 +144,14 @@
>         (atol char-ptr))
>        (:int32
>         (atoi char-ptr))
> +      (:int64
> +       (strtoll char-ptr))
>        (:uint32
>         (strtoul char-ptr))
>        (:uint
>         (strtoul char-ptr))
> -      ((:int64 :uint64)
> -       (uffi:with-foreign-object (high32-ptr :unsigned-int)
> -         (let ((low32 (atol64 char-ptr high32-ptr))
> -               (high32 (uffi:deref-pointer high32-ptr :unsigned-int)))
> -           (if (zerop high32)
> -               low32
> -               (make-64-bit-integer high32 low32)))))
> +      (:uint64
> +       (strtoull char-ptr))
>        (:blob
>         (if length
>             (uffi:convert-from-foreign-usb8 char-ptr length)