From 8997e2789a6677f5d5c78e0b630090824be30307 Mon Sep 17 00:00:00 2001 From: Russ Tyndall Date: Tue, 7 Jan 2014 14:03:45 -0500 Subject: [PATCH] Merging long-long vs unsigned-long-long fixes and test cases (thanks Aaron Burrows) Removing commented code that is no longer needed (thanks vityok@github) --- CONTRIBUTORS | 6 ++- LATEST-TEST-RESULTS | 27 +++++++++++++ clsql-uffi.asd | 53 ------------------------- tests/test-basic.lisp | 27 +++++++++++++ uffi/clsql-uffi-loader.lisp | 13 ------- uffi/clsql-uffi.lisp | 77 ++++++++++++++++++------------------- 6 files changed, 96 insertions(+), 107 deletions(-) diff --git a/CONTRIBUTORS b/CONTRIBUTORS index c7b1b5b..331f253 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -5,7 +5,11 @@ Marcus Pearce (initial port UncommonSQL, co-developer of Pierre Mai (original author MaiSQL from which CLSQL was based) Aurelio Bignoli (SQLite backend) Marc Battyani (Large object support for postgresql, initial connection pool code) -Nathan Bird (sponsored by http://www.acceleration.net/programming/) +Ryan Davis, Nathan Bird, & Russ Tyndall (sponsored by http://www.acceleration.net/programming/) +Victor (vityok@github), sqlite3 backend updates and clsql_uffi long-long support +Aaron Burrows, clsql_uffi unsigned integer bugs + + USQL Contributors diff --git a/LATEST-TEST-RESULTS b/LATEST-TEST-RESULTS index 71b6115..22d69f2 100644 --- a/LATEST-TEST-RESULTS +++ b/LATEST-TEST-RESULTS @@ -91,3 +91,30 @@ MYSQL: All 217 tests passed (ppc, OpenMCL). SQLITE: All 224 tests passed (ppc, OpenMCL). ODBC/POSTGRESQL: All 232 tests passed (ppc, OpenMCL). ODBC/MYSQL: All 217 tests passed (ppc, OpenMCL). + +---- +SQLITE3 After vityok, aaron burrows patches + +13 out of 300 total tests failed: :FDDL/CACHE-TABLE-QUERIES/1, :FDDL/INDEX/3, + :FDDL/VIEW/2, :FDDL/ATTRIBUTES/8, :FDDL/ATTRIBUTES/7, :FDDL/ATTRIBUTES/6, + :FDDL/ATTRIBUTES/5, :FDDL/ATTRIBUTES/4, :FDDL/ATTRIBUTES/3, + :FDDL/ATTRIBUTES/2, :FDDL/ATTRIBUTES/1, :FDDL/TABLE/3, :FDDL/TABLE/1. +Tests skipped: + TIME/PG/OODML/USEC Postgres specific test. + TIME/PG/OODML/NO-USEC Postgres specific test. + TIME/PG/FDML/USEC Postgres specific test. + OODML/SELECT/5 boolean where not supported. + FDML/SELECT/33 not supported by sqlite3. + FDML/SELECT/32 not supported by sqlite3. + FDML/SELECT/21 not supported by sqlite3. + FDML/SELECT/11 boolean where not supported. + FDML/SELECT/10 not supported by sqlite3. + FDML/SELECT/1 fancy math not supported. + FDDL/OWNER/SEQUENCE table ownership not supported. + FDDL/OWNER/INDEX table ownership not supported. + FDDL/OWNER/ATTRIBUTE-TYPES table ownership not supported. + FDDL/OWNER/ATTRIBUTES table ownership not supported. + FDDL/OWNER/TABLE table ownership not supported. + FDDL/OWNER/1 table ownership not supported. + FDDL/VIEW/4 not supported by sqlite3. + CONNECTION/QUERY-COMMAND known to work only in MySQL as yet. \ No newline at end of file diff --git a/clsql-uffi.asd b/clsql-uffi.asd index 84bfeb2..90e77de 100644 --- a/clsql-uffi.asd +++ b/clsql-uffi.asd @@ -19,57 +19,6 @@ (defpackage clsql-uffi-system (:use #:asdf #:cl)) (in-package clsql-uffi-system) -;; (defvar *clsql-uffi-library-dir* -;; (merge-pathnames "uffi/" -;; (make-pathname :name nil :type nil :defaults *load-truename*))) - -;; (defclass clsql-uffi-source-file (c-source-file) -;; ()) - - -;; (defmethod output-files ((o compile-op) (c clsql-uffi-source-file)) -;; (let* ((library-file-type -;; (funcall (intern (symbol-name'#:default-foreign-library-type) -;; (symbol-name '#:uffi)))) -;; (found -;; (some #'(lambda (dir) -;; (probe-file (make-pathname -;; :directory dir -;; :name (component-name c) -;; :type library-file-type))) -;; '((:absolute "usr" "lib" "clsql"))))) -;; (list (if found -;; found -;; (make-pathname :name (component-name c) -;; :type library-file-type -;; :defaults *clsql-uffi-library-dir*))))) - -;; (defmethod perform ((o load-op) (c clsql-uffi-source-file)) -;; nil) ;;; library will be loaded by a loader file - -;; (defmethod operation-done-p ((o load-op) (c clsql-uffi-source-file)) -;; (and (find-package '#:clsql-uffi) -;; (symbol-function (intern (symbol-name '#:atol64) -;; (find-package '#:clsql-uffi))) -;; t)) - -;; (defmethod perform ((o compile-op) (c clsql-uffi-source-file)) -;; (unless (operation-done-p o c) -;; #-(or win32 win64 windows mswindows) -;; (unless (zerop (run-shell-command -;; #-(or freebsd netbsd) "cd ~A; make" -;; #+(or freebsd netbsd) "cd ~A; gmake" -;; (namestring *clsql-uffi-library-dir*))) -;; (error 'operation-error :component c :operation o)))) - -;; (defmethod operation-done-p ((o compile-op) (c clsql-uffi-source-file)) -;; (or (and (probe-file #p"/usr/lib/clsql/clsql_uffi.so") t) -;; (let ((lib (make-pathname :defaults (component-pathname c) -;; :type (funcall (intern (symbol-name '#:default-foreign-library-type) -;; (find-package '#:uffi)))))) -;; (and (probe-file lib) (probe-file (component-pathname c)) -;; (> (file-write-date lib) (file-write-date (component-pathname c))))))) - (defsystem clsql-uffi :name "cl-sql-base" :author "Kevin M. Rosenberg " @@ -85,7 +34,5 @@ ((:module :uffi :components ((:file "clsql-uffi-package") -;; (:clsql-uffi-source-file "clsql_uffi" :depends-on ("clsql-uffi-package")) -;; (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package" "clsql_uffi")) (:file "clsql-uffi-loader" :depends-on ("clsql-uffi-package")) (:file "clsql-uffi" :depends-on ("clsql-uffi-package")))))) diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp index 24129e6..4ccc02d 100644 --- a/tests/test-basic.lisp +++ b/tests/test-basic.lisp @@ -226,6 +226,22 @@ "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 +301,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-loader.lisp b/uffi/clsql-uffi-loader.lisp index 04b9f24..8b12cc8 100644 --- a/uffi/clsql-uffi-loader.lisp +++ b/uffi/clsql-uffi-loader.lisp @@ -50,16 +50,3 @@ well as any of the filenames in any of the clsql:*foreign-library-search-paths*" "Used only by CMU. List of library flags needed to be passed to ld to load the MySQL client library succesfully. If this differs at your site, set to the right path before compiling or loading the system.") - -(defvar *uffi-library-loaded* nil - "T if foreign library was able to be loaded successfully") - -;; (defun load-uffi-foreign-library () -;; (clsql:push-library-path clsql-uffi-system::*clsql-uffi-library-dir*) -;; (find-and-load-foreign-library *clsql-uffi-library-filenames* -;; :module "clsql-uffi" -;; :supporting-libraries -;; *clsql-uffi-supporting-libraries*) -;; (setq *uffi-library-loaded* t)) - -;; (load-uffi-foreign-library) diff --git a/uffi/clsql-uffi.lisp b/uffi/clsql-uffi.lisp index 76dfd04..a27ea61 100644 --- a/uffi/clsql-uffi.lisp +++ b/uffi/clsql-uffi.lisp @@ -78,6 +78,13 @@ (radix :int)) :returning :unsigned-long-long) +#-windows +(uffi:def-function ("strtoll" c-strtoll) + ((str (* :unsigned-char)) + (endptr (* :unsigned-char)) + (radix :int)) + :returning :long-long) + #+windows (uffi:def-function ("_strtoui64" c-strtoull) ((str (* :unsigned-char)) @@ -85,6 +92,13 @@ (radix :int)) :returning :unsigned-long-long) +#+windows +(uffi:def-function ("_strtoi64" c-strtoll) + ((str (* :unsigned-char)) + (endptr (* :unsigned-char)) + (radix :int)) + :returning :long-long) + (uffi:def-function "atol" ((str (* :unsigned-char))) :returning :long) @@ -127,50 +141,33 @@ (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)) - (cond - ((uffi:null-pointer-p char-ptr) - nil) - (t + (declare (optimize (speed 3) (safety 0) (space 0)) + (type char-ptr-def char-ptr)) + (unless (uffi:null-pointer-p char-ptr) (case type - (:double - (atof char-ptr)) - (:int - (atol char-ptr)) - (:int32 - (atoi char-ptr)) - (:uint32 - (strtoul char-ptr)) - (:uint - (strtoul char-ptr)) - ((:int64 :uint64) - (strtoull char-ptr) - #|(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))))|# -) + (:double (atof char-ptr)) + (:int (atol char-ptr)) + (:int32 (atoi char-ptr)) + (:uint32 (strtoul char-ptr)) + (:uint (strtoul char-ptr)) + (:int64 (strtoll char-ptr)) + (:uint64 (strtoull char-ptr)) (:blob (if length (uffi:convert-from-foreign-usb8 char-ptr length) (error "Can't return blob since length is not specified."))) (t - (if encoding - (if length - (uffi:convert-from-foreign-string char-ptr - :null-terminated-p nil - :length length - :encoding encoding) - (uffi:convert-from-foreign-string char-ptr - :null-terminated-p t - :encoding encoding)) - (if length - (uffi:convert-from-foreign-string char-ptr - :null-terminated-p nil - :length length) - (uffi:convert-from-foreign-string char-ptr - :null-terminated-p t)))))))) + ;; NB: this used to manually expand the arg list based on if length and encoding + ;; were provided. If this is required the macro is aweful and should be rewritten + ;; to accept nil args (as it appears to) + (uffi:convert-from-foreign-string + char-ptr + :null-terminated-p (null length) + :length length + :encoding encoding))))) -- 2.34.1