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)