@@ -21,16 +19,24 @@ ODBC documentation from Microsoft.
-- Plain-odbc uses CFFI to interface to the odbc libaries. I have tested it on - Windows LispWorks Personal Edition (4.4) and - CLISP 2.38. I am too lazy to download the new version of - an "Allegro CL Trial Edition", but I am confident that this should also work. - On Windows ODBC connections to Oracle and SQL-Server work. - On Linux plain-odbc has been tested with CLISP and MySQL. -
- ++ Plain-odbc uses CFFI to interface to the ODBC libaries. + The development platform ist clisp on Windows XP. + On this system accessing Microsoft SQL-Server, Oracle 10g and MySQL 5.0 works. + I do not expect big problems with other databases which have an ODBC driver. + If there are problems they can also originate from the implementation of the + ODBC driver, e.g. MyODBC does not support out parameters. + At one time plain-odbc worked on Windows with LispWorks Personal Edition (4.4) + and Allegro. + On Linux it worked with CMUCL and MySQL. Since the interface to the ODBC library + is done with + CFFI, plain-odbc should still with on these platforms/systems. +
++ David Owen made the necessary changes to the code to make it run on + 64-bit Linux CMUCL and MySQL. +
(asdf:oos 'asdf:load-op :plain-odbc)
@@ -75,5 +81,5 @@
Oracle does not really have integer columns, integer is just a short hand
for number(37,0), and in a query this is returned as decimal.
- And plain-odbc converts decimals to doubles.
+ And plain-odbc converts decimals to doubles.
[9]> (exec-update *con* "update test1 set y=? where x=?" "text2" 1)
@@ -223,4 +229,20 @@
actual parameter.
+ Note: MySql does not support out and in/out parameters. There are no
+ return parameters. A citation from the documentation of MySql:
+
+
+For programs written in a language that provides a MySQL interface, there is no native method for directly retrieving the results of OUT or INOUT parameters from CALL statements. To get the parameter values, pass user-defined variables to the procedure in the CALL statement and then execute a SELECT statement to produce a result set containing the variable values. The following example illustrates the technique (without error checking) for a stored procedure p1 that has two OUT parameters.
+
+mysql_query(mysql, "CALL p1(@param1, @param2)");
+mysql_query(mysql, "SELECT @param1, @param2");
+result = mysql_store_result(mysql);
+row = mysql_fetch_row(result);
+mysql_free_result(result);
+
+
+
+
+
The function prepare-statement is called with the parameters
@@ -236,6 +258,6 @@
Currently the only parameter is the maximal length parameter for
the string and binary (= Oracle's raw) datatypes. Instead of a list for
- a parameter description only the name of the parameter type can be given. This is
- equivalent to a list with two elements: the symbol and the direction :in.
+ a parameter description only the name of the parameter type can be given.
+ This is equivalent to a list with two elements: the symbol and the direction :in.
The following parameter types ares supported:
@@ -337,5 +359,5 @@
the value returns true then the value is passed as :date. Of course
*date-datatype-to-universal-time* must be able to convert
- the value universal time.
+ the value to universal time.
@@ -387,12 +409,12 @@
[Function]
- connect-sql-server server database &optional user password
- Connect to sql server named server, the initial database is database.
- If user and password are supplied the connection is made with sql server
- authentication, if the parameters are not supplied then the connection is made with
- integrated security. The name of the template odbc datasource for this function is
- default-sql-server-dsn.
-
-
+ connect-sql-server server database &optional user password
+ Connect to sql server named server, the initial database is database.
+ If user and password are supplied the connection is made with sql server
+ authentication, if the parameters are not supplied then the connection is made with
+ integrated security. The name of the template odbc datasource for this function is
+ default-sql-server-dsn.
+
+
[Function]
connect-oracle server user password
@@ -401,12 +423,21 @@
default-oracle-dsn.
-
-
[Function]
- connect-access filename
+
+
[Function]
+ connect-access filename
Connect to the access database (a .mdb file) with name filename.
The name of the template odbc datasource for this function is
default-access-dsn.
-
+
+
[Function]
+ connect-mysql server database user password
+ Connect to the MySql server on server connecting as user
+ user with password password. The default database is
+ database. If database is NIL no database is chosen.
+ The name of the template odbc datasource for this function is
+ default-mysql-dsn.
+
+
Working with Connections
@@ -428,5 +459,5 @@
If a column is a LOB (BLOB or CLOB) then the data is retrieved
with the ODBC function SQLGetData. This has the consequence that
- thr following columns must also be retrieved with SQLGetData,
+ the following columns must also be retrieved with SQLGetData,
otherwise an error is raised by the driver.
Retrieving the following columns via
@@ -440,4 +471,9 @@
But be carefull with the conversion format (1.23 vs. 1,23).
+
+
[Function]
+ exec-query*connection sqlstring parameters
+ The same as exec-query, but the ODBC parameters are passed as a list.
+
[Function]
@@ -447,4 +483,9 @@
list of parameter descriptions.
+
+
[Function]
+ exec-update*connection sqlstring parameters
+ The same as exec-update, but the ODBC parameters are passed as a list.
+
[Function]
@@ -453,5 +494,11 @@
parameters is a list of parameter descriptions.
Returns the list of out and in-out parameters.
-
+
+
+
[Function]
+ exec-command*connection sqlstring parameters
+ The same as exec-command, but the ODBC parameters are passed as a list.
+
+
NOTE
@@ -460,6 +507,26 @@
One can execute a select statement with exec-update and
exec-command. But the command for exec-query
- must return a resultset.
-
+ must return a resultset. The following functions offers the functionality
+ of all three functions:
+
+
[Function]
+ exec-sql connection sqlstring &rest parameters
+ Execute an sql statement (select, dml or stored procedure call) on connection
+ with sql sqlstring. parameters is a list of parameter descriptions.
+ This function returns three values
+
+
[Function]
+ exec-sql*connection sqlstring parameters
+ The same as exec-sql, but the ODBC parameters are passed as a list.
+
[Function]
Index: 64-bit/doc/notes.html
===================================================================
--- 64-bit/doc/notes.html (revision 64-bit,2.1.2)
+++ 64-bit/doc/notes.html (revision 64-bit,2.1.3)
@@ -1,6 +1,12 @@
-
+
+
This documents contains some observations and pitfalls encountered + when using different drivers and databases. +
+More Information about Oracle ODBC Driver +There is documentation for the Oracle ODBC driver, it is at
+ +Oracle® Database Administrator's Reference-I can not make Oracle return unicode. I am using a 9.2 DB I have created a nchar column which is a unicode datatype for 9.2. +I can not make Oracle return unicode. I am using a 9.2 DB I have created a nchar column which is a +unicode datatype for 9.2.
I am using the oracle driver. There is a workaround tab where one can force the driver to @@ -99,4 +119,17 @@ Only selecting from NLS_SESSION_PARAMETERS returns a 16bit charcater. Or do I have this problem since NLS_CHARACTERSET=WE8ISO8859P15? +
+[13]> (schar (caar (exec-query *con* "select nCHR(232) from dual")) 0) + +#\LATIN_SMALL_LETTER_E_WITH_GRAVE +[14]> + +[16]> (char-code (schar (caar (exec-query *con* "select ? from dual" (list (string (code-char 1234)) :unicode-string)) ) 0)) + +1234 ++
@@ -127,11 +162,15 @@
(with-prepared-statement (stm con
"{call test99_pkg.test_cursor(?,?)}"
- '((:string :in )))
+ '(:string :in ))
(let ((str "just a string"))
- (exec-prepared-query stm (list str))))
-
-Note that the cursor parameter must be declared in/out. If a parameter ist supplied for the cursor parameter, it still works. This needs more investigations.
-
-
-mysql> create view bla as select date_add('2007-8-1',interval 1 day) as a;
+MySQL> create view bla as select date_add('2007-8-1',interval 1 day) as a;
Query OK, 0 rows affected (0.01 sec)
-mysql> desc bla
+MySQL> desc bla
-> ;
+-------+---------------+------+-----+---------+-------+
@@ -159,8 +200,8 @@
how to do it right:
-mysql> create view bla2 as select date_add(cast('2007-8-1' as datetime),interval 1 day) as a;
+MySQL> create view bla2 as select date_add(cast('2007-8-1' as datetime),interval 1 day) as a;
Query OK, 0 rows affected (0.00 sec)
-mysql> desc bla2;
+MySQL> desc bla2;
+-------+----------+------+-----+---------+-------+
| Field | Type | Null | Key | Default | Extra |
@@ -179,5 +220,5 @@
server settings:
-mysql> select cast(cast('12345678901' as decimal) as char) as a, cast(cast('1234567890' as decimal) as char) as b;
+MySQL> select cast(cast('12345678901' as decimal) as char) as a, cast(cast('1234567890' as decimal) as char) as b;
+------------+------------+
| a | b |
@@ -191,11 +232,11 @@
Division by zero is handled, but only for an insert:
-mysql> set @a=1;
+MySQL> set @a=1;
Query OK, 0 rows affected (0.00 sec)
-mysql> set @b=0;
+MySQL> set @b=0;
Query OK, 0 rows affected (0.00 sec)
-mysql> select @a/@b;
+MySQL> select @a/@b;
+-------+
| @a/@b |
@@ -205,7 +246,78 @@
1 row in set, 1 warning (0.00 sec)
-mysql> insert into blu select @a/@b;
+MySQL> insert into blu select @a/@b;
ERROR 1365 (22012): Division by 0
+Handling of numbers
+
+[130]> (exec-query *con* "select cast(1.5e0/3.9e0 as char(200)) as a")
+
+(("0.38461538461538")) ;
+("a")
+[131]> (exec-query *con* "select cast(cast(1.5e0/3.9e0 as decimal(40,20)) as char(200)) as a")
+
+(("0.38461538461538460000")) ;
+("a")
+
+In clisp on x86 I get:
+
+[132]> (/ 1.5d0 3.9d0)
+
+0.38461538461538464d0
+
+With sql server I get the same value, as with clisp.
+
+And another example :
+
+MySQL> select 1e14/7e0,1e14/7e0-14285714285714;
++----------------+-------------------------+
+| 1e14/7e0 | 1e14/7e0-14285714285714 |
++----------------+-------------------------+
+| 14285714285714 | 0.28515625 |
++----------------+-------------------------+
+1 row in set (0.00 sec)
+
+The decimal expansion of 1/7 is periodic, so the digits 0.285 are correct. Thus
+MySQL uses the precision of double, but does not return all digits.
+
+Parameters
+
+As mentioned in the documentation, MySQL does not support out and in/out
+parameters for sql statements. As the documentation of MySQL suggest
+one should declare variables, pass them as parameters to the stored
+procedures. After the procedure call one get there contents with a select
+statement, example: select @param1 as param1,@param2 as param2.
+
+
+
+The problem with variables on MySQL is that one can only set them. It is
+not possible to declare a datatype for them.
+Another option is to select the parameters directly in the stored procedure.
+Thus instead of having out or in/out parameters, the procedure returns
+return values as a result set. Note that exec-query accepts parameters
+and can return more than one result set. One example, assume
+*con* is a MySQL connection.
+
+[33]> (exec-command *con* "
+ create procedure test99(a1 varchar(200),b1 int,c1 date)
+ begin
+ declare a2 varchar(200);
+ declare b2 int;
+ declare c2 date;
+ set a2=concat(a1,'x');
+ set b2=b1+3;
+ set c2=c1+ interval 1 day;
+ select a2 as a2,b2 as b2, c2 as c2;
+ end;")
+
+
+[34]> (exec-query *con* "call test99(?,?,?)" "abc"
+ (list 12 :integer) (list (encode-universal-time 12 3 5 12 11 2007) :date))
+
+(("abcx" 15 3403897200)) ;
+("a2" "b2" "c2")
+[35]>
+
+
Index: 64-bit/license.txt
===================================================================
--- 64-bit/license.txt (revision 64-bit,1)
+++ 64-bit/license.txt (revision 64-bit,2.1.3)
@@ -1,9 +1,12 @@
-This system contains codefrom Paul Meurer, Joerg Hoehle and Roland Averkamp.
+This system contains code from Paul Meurer and Roland Averkamp.
+
+David Owen made the necessary adjustments to the code to
+make it run on 64-bit Linux.
This system contains code from Paul Meurer:
the FFC system was written by him and also
-the the lower level parts of the system:
-src/odbc/codbc-constants.lisp
+the lower level parts of the system:
+src/odbc/odbc-constants.lisp
src/odbc/odbc-ff-interface.lisp
src/odbc/ odbc-functions.lisp
@@ -34,11 +37,4 @@
-The uffi system is written by Goerg Hoehle
-this is the file src/uff-clisp/uffi.lisp
-And this is his license
-(c) 2004-2005 Joerg Hoehle
-Copyright: Allegro's LispLGPL (LLGPL)
-
-
The upper parts of the system are written by me (Roland Averkamp)
and carry my copyright notice. For my code I use the new BSD license.
Index: 64-bit/plain-odbc.asd
===================================================================
--- 64-bit/plain-odbc.asd (revision 64-bit,1)
+++ 64-bit/plain-odbc.asd (revision 64-bit,2.1.3)
@@ -9,5 +9,5 @@
(:file "odbc-constants")
(:file "global")
- (:file "cffi-support")
+ (:file "ffi-support")
(:file "odbc-ff-interface")
(:file "odbc-functions")
Index: 64-bit/src/odbc/odbc-functions.lisp
===================================================================
--- 64-bit/src/odbc/odbc-functions.lisp (revision 64-bit,2.1.1)
+++ 64-bit/src/odbc/odbc-functions.lisp (revision 64-bit,2.1.3)
@@ -47,5 +47,5 @@
;; TODO: Why doesn't this use with-temporary-allocations? -dso
(defun handle-error (henv hdbc hstmt)
- (let
+ (with-temporary-allocations
((sql-state (alloc-chars 256))
(error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
@@ -63,9 +63,4 @@
(cffi:mem-ref error-code 'sql-integer))))
-
-; test this: return a keyword for efficiency
-;; rav,
-;; problem: calling SQLError clears the error state
-;#+ignore
(defun sql-state (henv hdbc hstmt)
(with-temporary-allocations
@@ -83,9 +78,6 @@
(defun error-handling-fun (result-code henv hdbc hstmt)
- ;; *** is this a bug in allegro or in my code??
- ;#+allegro (setf result-code (short-to-signed-short result-code))
-
(case result-code
- (#.$SQL_SUCCESS (values result-code nil))
+ ((#.$SQL_SUCCESS #.$SQL_NO_DATA_FOUND) (values result-code nil))
((#.$SQL_SUCCESS_WITH_INFO #.$SQL_ERROR)
(multiple-value-bind (error-message sql-state msg-length error-code)
@@ -102,12 +94,17 @@
:sql-state sql-state
:error-code error-code))))
-
+ ; this can happen, using a wrong handle
(#.$SQL_INVALID_HANDLE
(values result-code
(make-condition 'sql-error :error-message "[ODBC error] Invalid handle")))
+ ;; maybe this should raise an error immediately
(#.$SQL_STILL_EXECUTING
(values result-code
(make-condition 'sql-error :error-message"[ODBC error] Still executing")))
- (otherwise (values result-code nil))
+ (#.$SQL_NEED_DATA
+ (values result-code nil))
+
+ ;; rav: hope above are all result codes I know
+ (otherwise (error "unknown result of odbc execution: ~A" result-code))
))
@@ -115,8 +112,7 @@
;;; rav:
;;; but the remaining macro is still large
-#+ignore
-(defmacro with-error-handling ((&key henv hdbc hstmt (print-info t))
+
+(defmacro with-error-handling ((&key henv hdbc hstmt)
odbc-call &body body)
- (declare (ignore print-info))
(let ((condition-var (gensym))
(result-code (gensym)))
@@ -129,41 +125,4 @@
-;;; rav:
-;; the original macro
-#-ignore
-(defmacro with-error-handling ((&key henv hdbc hstmt (print-info t))
- odbc-call &body body)
- (let ((result-code (gensym)))
- `(let ((,result-code ,odbc-call))
- ;; *** is this a bug in allegro or in my code??
- ;#+allegro (setf ,result-code (short-to-signed-short ,result-code))
- (case ,result-code
- (#.$SQL_SUCCESS
- (progn ,result-code ,@body))
- (#.$SQL_SUCCESS_WITH_INFO
- (when ,print-info
- (multiple-value-bind (error-message sql-state)
- (handle-error (or ,henv (cffi:null-pointer))
- (or ,hdbc (cffi:null-pointer))
- (or ,hstmt (cffi:null-pointer)))
- (warn "[ODBC info] ~a state: ~a"
- ,result-code error-message
- sql-state)))
- (progn ,result-code ,@body))
- (#.$SQL_INVALID_HANDLE
- (error "[ODBC error] Invalid handle"))
- (#.$SQL_STILL_EXECUTING
- (error "[ODBC error] Still executing"))
- (#.$SQL_ERROR
- (multiple-value-bind (error-message sql-state)
- (handle-error (or ,henv (cffi:null-pointer))
- (or ,hdbc (cffi:null-pointer))
- (or ,hstmt (cffi:null-pointer)))
- (error "[ODBC error] ~a; state: ~a" error-message sql-state)))
- (otherwise
- (progn ,result-code ,@body))
- ))))
-
-
(defun %new-environment-handle ()
(cffi:with-foreign-object (phenv 'sql-h-env)
@@ -196,18 +155,4 @@
(progn ,@body)
(%free-statement ,hstmt :drop))))
-
-;;; rav: ignored
-#+ignore
-(defmacro %with-transaction ((henv hdbc) &body body)
- (let ((successp (gensym)))
- `(let ((,successp nil))
- (unwind-protect
- (prog1
- (progn ,@body)
- (setf ,successp t))
- (with-error-handling (:henv ,henv :hdbc ,hdbc)
- (SQLTransact
- ,henv ,hdbc
- (if ,successp $SQL_COMMIT $SQL_ROLLBACK)))))))
;; functional interface
@@ -595,5 +540,5 @@
(declare (type (integer 0) column-nr))
(with-error-handling
- (:hstmt hstmt :print-info nil)
+ (:hstmt hstmt)
(SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr))
c-type data-ptr precision out-len-ptr)))
@@ -606,5 +551,5 @@
(defun %sql-param-data (hstmt param-ptr)
- (with-error-handling (:hstmt hstmt :print-info t) ;; nil
+ (with-error-handling (:hstmt hstmt)
(SQLParamData hstmt param-ptr)))
@@ -612,5 +557,5 @@
(defun %sql-put-data (hstmt data-ptr size)
(with-error-handling
- (:hstmt hstmt :print-info t) ;; nil
+ (:hstmt hstmt )
(SQLPutData hstmt data-ptr size)))
Index: 64-bit/src/odbc/odbc-main.lisp
===================================================================
--- 64-bit/src/odbc/odbc-main.lisp (revision 64-bit,2.1.2)
+++ 64-bit/src/odbc/odbc-main.lisp (revision 64-bit,2.1.3)
@@ -106,5 +106,4 @@
-;;; fixme, is this correct?
(defmethod print-object ((connection odbc-connection) s)
(format s "#<~A SERVER=~S DBMS=~S USER=~S>"
@@ -310,5 +309,5 @@
(error "not able to deduce parameter specification for ~A" obj)))))
-(defun exec-sql (connection sql parameter-list)
+(defun exec-sql-statement (connection sql parameter-list)
(let ((query (make-query connection)))
(unwind-protect
@@ -358,7 +357,15 @@
)))
+(defun exec-sql* (connection sql parameter-list)
+ (exec-sql-statement connection sql parameter-list))
+
+(defun exec-sql (connection sql &rest parameter-list)
+ (exec-sql* connection sql parameter-list))
+
+
+
(defun exec-query* (connection sql parameter-list)
(multiple-value-bind (rows result-sets out-params)
- (exec-sql connection sql parameter-list)
+ (exec-sql-statement connection sql parameter-list)
(declare (ignore rows) (ignore out-params))
(let ((res nil))
@@ -373,5 +380,5 @@
(defun exec-update* (connection sql parameter-list)
(multiple-value-bind (rows result-sets out-params)
- (exec-sql connection sql parameter-list)
+ (exec-sql-statement connection sql parameter-list)
(declare (ignore result-sets out-params))
rows))
@@ -382,5 +389,5 @@
(defun exec-command* (connection sql parameter-list)
(multiple-value-bind (rows result-sets out-params)
- (exec-sql connection sql parameter-list)
+ (exec-sql-statement connection sql parameter-list)
(declare (ignore rows result-sets))
(values-list out-params)))
Index: 64-bit/src/odbc/odbc-utilities.lisp
===================================================================
--- 64-bit/src/odbc/odbc-utilities.lisp (revision 64-bit,2.1.1)
+++ 64-bit/src/odbc/odbc-utilities.lisp (revision 64-bit,2.1.3)
@@ -44,7 +44,12 @@
)))
-(defun connect-mysql (server user password)
- (connect-generic :dsn *default-mysql-dsn*
- :server server :uid user :pwd password))
+(defun connect-mysql (server database user password)
+ (apply 'connect-generic
+ (append
+ (list :dsn *default-mysql-dsn*
+ :server server :uid user :pwd password)
+ (if database (list :database database) ())
+ )))
+
Index: 64-bit/src/odbc/plain-odbc-package.lisp
===================================================================
--- 64-bit/src/odbc/plain-odbc-package.lisp (revision 64-bit,2.1.2)
+++ 64-bit/src/odbc/plain-odbc-package.lisp (revision 64-bit,2.1.3)
@@ -14,8 +14,10 @@
; #+mcl "CCL" #+cormanlisp "WIN32" "CFFI")
(:export
+ "EXEC-SQL"
"EXEC-QUERY"
"EXEC-UPDATE"
"EXEC-COMMAND"
+ "EXEC-SQL*"
"EXEC-QUERY*"
"EXEC-UPDATE*"
@@ -26,6 +28,6 @@
"EXEC-PREPARED-UPDATE"
"EXEC-PREPARED-COMMAND"
- "FREE-STATEMENT"
- "CONNECT"
+ "FREE-STATEMENT"
+ "CONNECT"
;"DRIVER-CONNECT"
"CONNECT-GENERIC"
Index: 64-bit/src/test/readme.txt
===================================================================
--- 64-bit/src/test/readme.txt (revision 64-bit,2)
+++ 64-bit/src/test/readme.txt (revision 64-bit,2.1.3)
@@ -17,6 +17,6 @@
The tests are started with the function run-mysql-tests,run-oracle-tests
-run-sql-server-tests. These function take one parameter, an
-odbc connection to thecorresponding database.
+and run-sql-server-tests. These function take one parameter, an
+odbc connection to the corresponding database.
[44]> (setf *con* (connect-oracle "ltrav1" "scott" "tiger"))
Index: 64-bit/src/test/test-mysql.lisp
===================================================================
--- 64-bit/src/test/test-mysql.lisp (revision 64-bit,2.1.2)
+++ 64-bit/src/test/test-mysql.lisp (revision 64-bit,2.1.3)
@@ -11,21 +11,29 @@
(defun run-mysql-tests (con)
- (make-mysql-type-test con)
- (mysql-test1 con)
- (mysql-test2 con)
- (mysql-test3 con)
- (mysql-test4 con)
- (mysql-test5 con)
- (mysql-test6a con)
- (mysql-test6b con)
- (mysql-test7 con)
- (mysql-test9 con)
- (mysql-test10 con)
- (mysql-test15 con)
- (mysql-test20 con)
- (mysql-test22 con)
- (mysql-test23 con)
- (mysql-test23b con)
- )
+ (dolist (sym '(
+ mysql-type-test
+ mysql-test1
+ mysql-test2
+ mysql-test3
+ mysql-test4
+ mysql-test5
+ mysql-test6a
+ mysql-test6b
+ mysql-test7
+ mysql-test9
+ mysql-test10
+ mysql-test15
+ mysql-test20
+ mysql-test22
+ mysql-test23
+ mysql-test23b
+ mysql-test24
+ mysql-test25
+ mysql-test26
+ mysql-test27
+ mysql-test28
+ ))
+ (pprint sym)
+ (funcall sym con)))
(defparameter *mysql-type_test-ddl* "
@@ -38,6 +46,4 @@
t_INT int,
t_BIGINT bigint,
-t_float24 float(24),
-t_float53 float(53),
t_float float,
t_DOUBLE double,
@@ -64,5 +70,5 @@
)
")
-(defun make-mysql-type-test (con)
+(defun mysql-type-test (con)
(ignore-errors (exec-command con "drop table type_test"))
(exec-command con *mysql-type_test-ddl*)
@@ -75,8 +81,6 @@
t_INT =987,
t_BIGINT =256*256*256*256 *256*256*256*127,
- t_float24 =9.67,
- t_float53 = 1.5/3.9,
- t_float =1.0/7.0,
- t_DOUBLE = 1.0/7.0,
+ t_float =1.0e0/7.0e0,
+ t_DOUBLE = 1.0e0/7.0e0,
t_decimal40_20 = '12345678901234567890.1234567890123456789',
t_dATE ='2004-6-25',
@@ -86,5 +90,5 @@
t_YEAR =1967,
T_char = 'abcdefghijkmlnop',
- t_varchar = 'abcdefghijklmnopqrstuvw',
+ t_varchar = 'abcdefghijklmnopqrstuvw'
/* -- t_TINYBLOB = lpad('a',33000),
-- t_TINYTEXT lpad('a',33000),
@@ -93,10 +97,18 @@
-- t_MEDIUMBLOB mediumblob,
-- t_MEDIUMTEXT mediumtext,
- t_LONGBLOB longblob, */
- t_LONGTEXT = lpad('a',33000,'x')
+ --t_LONGBLOB longblob,
+ --t_LONGTEXT = lpad('a',33000,'x')
where id =1
")
(commit con)
- (let ((res (exec-query con "
+ (let ((stm (prepare-statement
+ con "update type_test set t_longblob =?, t_longtext=? where id =1"
+ '(:blob :in) '(:clob :in))))
+ (exec-prepared-update stm
+ (make-array 10000 :element-type '(unsigned-byte 8)
+ :initial-element 33)
+ (make-string 100001 :initial-element #\o)))
+ (commit con)
+ (let ((res (exec-query con "
select t_tinyint,
t_smallint,
@@ -104,6 +116,4 @@
t_int,
t_bigint,
- t_float24,
- t_float53,
t_float,
t_double,
@@ -115,17 +125,32 @@
t_char,
t_varchar,
+ t_longblob,
t_longtext
- from type_test where id=1
-")))
- ;(pprint res)
- )
- (let ((stm (prepare-statement
- con "update type_test set t_longblob =?, t_longtext=? where id =1"
- '(:blob :in) '(:clob :in))))
- (exec-prepared-update stm
- (make-array 10000 :element-type '(unsigned-byte 8)
- :initial-element 33)
- (make-string 100001 :initial-element #\o)))
-(commit con))
+ from type_test where id=1")))
+ (assert (= (length res) 1))
+ (setf res (first res))
+ (assert (equal (nth 0 res) 1))
+ (assert (equal (nth 1 res) 255))
+ (assert (equal (nth 2 res) (* 256 256 127)))
+ (assert (equal (nth 3 res) 987))
+ (assert (equal (nth 4 res) (* 256 256 256 256 256 256 256 127)))
+ ;; these are skipped since support for double in myslq is bad
+ ;;(assert (equal (nth 5 res) (/ 1 7.0)))
+ ;;(assert (equal (nth 6 res) (/ 1 7d0)))
+ ;; skipped because we do not have decimal as a datatype
+ (assert (equal (nth 7 res) 12345678901234567890.1234567890123456789d0))
+ (assert (equal (nth 8 res) (encode-universal-time 0 0 0 25 6 2004)))
+ (assert (equal (nth 9 res) (encode-universal-time 34 56 13 13 5 2004)))
+ (assert (equal (nth 10 res) "12:56:00"))
+ ;; year is returend as SQL_SMALLINT
+ (assert (equal (nth 11 res) 1967))
+ (assert (equal (nth 12 res) "abcdefghijkmlnop"))
+ (assert (equal (nth 13 res) "abcdefghijklmnopqrstuvw"))
+ (assert (equal (coerce (nth 14 res) 'list)
+ (coerce (make-array 10000 :element-type '(unsigned-byte 8)
+ :initial-element 33 :adjustable t) 'list)))
+ (assert (equal (nth 15 res) (make-string 100001 :initial-element #\o)))
+ ))
+
@@ -175,5 +200,5 @@
(with-prepared-statement (stm con "insert into type_test (id,t_double) values(99,?)"
'(:double :in))
- (exec-prepared-update stm 1.8))
+ (exec-prepared-update stm 1.8d0))
(let ((res (exec-query con "select t_double+1 from type_test where id=99")))
(assert (<= (abs (- (caar res) 2.8d0)) 1d-7))))
@@ -431,17 +456,93 @@
create procedure test99 (a decimal,b varchar(200))
begin
- select 3*a as a, 'x' + b +'y' as b, cast('2003-4-1' as datetime) as c;
+ select 3*a as a, concat('x' , b ,'y') as b, cast('2003-4-1' as datetime) as c;
select uuid() as x,cast(123456789012345678 as signed) as y,cast('abcdefghijklmnop' as binary) as z;
end;")
- (with-prepared-statement
- (stm con "{call test99(?,?)}"
- '(:integer :in) '(:string :in))
- (multiple-value-bind (r1 c1 r2 c2) (exec-prepared-query stm 123456789 "abcdefghijklmn")
+ (multiple-value-bind (r1 c1 r2 c2) (exec-query con "{call test99(?,?)" 123456789 "abcdefghijklmn")
(assert (equal c1 '("a" "b" "c")))
(assert (equal c2 '("x" "y" "z")))
- (assert (equal r1 (list (* 3.0d 123456789) "xabcdefghijklmny"
+ (assert (equal (first r1) (list (* 3.0d0 123456789) "xabcdefghijklmny"
(encode-universal-time 0 0 0 1 4 2003))))
- (assert (equal (rest r2 ) (list 123456789012345678
- (map vector 'char-code "abcdefghijklmn")))))))
-
+ (assert (equal (second (first r2 )) 123456789012345678 ))
+ (assert (equal (coerce (third (first r2)) 'list) (coerce (map 'vector 'char-code "abcdefghijklmnop") 'list)))))
+
+(defun mysql-test26 (con)
+ (mysql-drop-test-table con "testtab99")
+ (exec-command con "create table testtab99 (id int,bla varchar(200))")
+ (exec-update con "insert into testtab99 (id,bla) values(1,'bla1')")
+ (exec-update con "insert into testtab99 (id,bla) values(2,'bla2')")
+ (assert (equal (exec-update con "update testtab99 set bla=? where id=?" "bla100" 1) 1))
+ (assert (equal (exec-update con "update testtab99 set bla=? where id=?" "bla100" 99) 0))
+ (with-prepared-statement
+ (stm con "update testtab99 set bla=? where id=?" :string :integer)
+ (assert (equal (exec-prepared-update stm "bla100" 1) 1))
+ (assert (equal (exec-prepared-update stm "bla100" 99) 0))
+ ))
+
+(defun mysql-test27 (con)
+ (mysql-drop-test-proc con "test99")
+ (exec-command con "
+ create procedure test99(a1 varchar(200),b1 int,c1 datetime)
+ begin
+ declare a2 varchar(200);
+ declare b2 int;
+ declare c2 datetime;
+ set a2=concat(a1,'x');
+ set b2=b1+3;
+ set c2=c1+ interval 3 day;
+ select a2 as a2,b2 as b2, c2 as c2;
+ end;")
+ (let* ((the-date (encode-universal-time 12 3 5 12 11 2007))
+ (res (exec-query con "call test99(?,?,?)" "abc"
+ (list 12 :integer ) (list the-date :date)))
+ (row (first res)))
+ (assert (equal (first row) "abcx"))
+ (assert (equal (second row) 15))
+ (assert (equal (third row) (+ the-date (* 3 86400))))))
+
+(defun mysql-test28 (con)
+ (mysql-drop-test-proc con "test99")
+ (exec-command con "
+ create procedure test99(a1 varchar(200),b1 int,c1 datetime)
+ begin
+ declare a2 varchar(200);
+ declare b2 int;
+ declare c2 datetime;
+ set a2=concat(a1,'x');
+ set b2=b1+3;
+ set c2=c1+ interval 3 day;
+ select a2 as \"a2\",b2 as \"b2\", c2 as \"c2\";
+ select c2 as \"c2\", b2 as \"b2\",a2 as \"a2\";
+
+ end;")
+ (let* ((the-date (encode-universal-time 12 3 5 12 11 2007)))
+ (multiple-value-bind (co resultsets params)
+ (exec-sql con "call test99(?,?,?)" "abc"
+ (list 12 :integer ) (list the-date :date))
+ (let* ((rs1 (first resultsets))
+ (rs2 (second resultsets))
+ (rows1 (first rs1))
+ (rows2 (first rs2))
+ (cols1 (second rs1))
+ (cols2 (second rs2))
+ (row1 (first rows1))
+ (row2 (first rows2)))
+ (assert (equal (first row1) "abcx"))
+ (assert (equal (second row1) 15))
+ (assert (equal (third row1) (+ the-date (* 3 86400))))
+
+ (assert (equal (third row2) "abcx"))
+ (assert (equal (second row2) 15))
+ (assert (equal (first row2) (+ the-date (* 3 86400))))
+
+ (assert (equal cols1 (list "a2" "b2" "c2")))
+ (assert (equal cols2 (list "c2" "b2" "a2")))
+ )
+ )))
+
+
+
+
+
+
Index: 64-bit/src/test/test-oracle.lisp
===================================================================
--- 64-bit/src/test/test-oracle.lisp (revision 64-bit,2.1.1)
+++ 64-bit/src/test/test-oracle.lisp (revision 64-bit,2.1.3)
@@ -15,9 +15,9 @@
ora-test6
ora-test7
- #+ignore ;; unicode support does not work for oracle
ora-test8
ora-test9
ora-test10
ora-test11
+ ora-test12
))
(pprint sym)
@@ -39,42 +39,80 @@
t_number number,
t_char char(2000) ,
- t_varchar varchar(4000),
+ t_varchar varchar2(4000),
+ t_nvarchar NVARCHAR2(200),
t_date date,
t_raw raw(2000),
t_blob blob,
- t_clob clob)
+ t_clob clob,
+ t_nclob nclob
+ )
")
+
+
+(defun ora-drop-test-proc (con proc)
+ (unless (zerop (caar (exec-query con (format nil "select count(*)
+ from user_objects where object_name='~A'" proc))))
+ (exec-command con (format nil "drop procedure ~A" proc))))
+
+(defun ora-drop-test-table (con proc)
+ (unless (zerop (caar (exec-query con (format nil "select count(*)
+ from user_objects where object_name='~A'" proc))))
+ (exec-command con (format nil "drop table ~A" proc))))
+
+
(defun oracle-type-test (con)
- (if (not (zerop (caar (exec-query con "select count(*) from user_tables where table_name ='TYPE_TEST'"))))
- (exec-command con "drop table type_test"))
+ (ora-drop-test-table con "TYPE_TEST")
(exec-command con *oracle-type_test-ddl*)
(exec-update con "insert into type_test (id) values(1)")
(exec-update con "
update type_test set
- t_integer= 123456789012345677989,
+ t_integer= 12345678901234,
t_number = 1.0/3.0,
t_char=rpad('1',1999),
- t_varchar =lpad('1',3999),
- t_date = sysdate,
+ t_varchar =lpad('1',39),
+ t_nvarchar = lpad(nchr(1234),200,nchr(1234)),
+ t_date = to_date('1.3.2005 12:23:14','dd.mm.yyyy hh24:mi:ss'),
t_raw =hextoraw('11223344556677889900')
where id =1")
- (exec-query con "select * from type_test")
(let ((stm (prepare-statement
- con "update type_test set t_blob=?,t_clob=? where id =1"
- '(:blob :in) '(:clob :in))))
+ con "update type_test set t_blob=?,t_clob=?,t_nclob=? where id =1"
+ '(:blob :in) '(:clob :in) '(:UNICODE-CLOB :in))))
(exec-prepared-update
stm ;; sizes were 100000 and 100001
(make-array 100000 :element-type '(unsigned-byte 8) :initial-element 33)
- (make-string 1000001 :initial-element #\o)))
+ (make-string 1000001 :initial-element #\o)
+ (make-string 1234567 :initial-element (code-char 3217))))
+ (let ((res (exec-query con "
+ select id,t_integer,t_number,t_char,t_varchar,t_date,t_raw, t_nvarchar from type_test where id=1")))
+ (assert (= (length res) 1))
+ (setf res (first res))
+ (assert (equal (nth 0 res) 1d0))
+ (assert (equal (nth 1 res) 12345678901234d0))
+ (assert (equal (nth 2 res) (/ 1d0 3)))
+ ;; t_char is of type char and therefor has always length 2000,
+ ;; although we inserted a string of length 1999
+ (assert (equal (nth 3 res)
+ (let ((a (make-string 2000 :initial-element #\space)))
+ (setf (schar a 0) #\1)
+ a)))
+ (assert (equal (nth 4 res)
+ (let ((a (make-string 39 :initial-element #\space)))
+ (setf (schar a 38) #\1)
+ a)))
+ (assert (equal (nth 5 res)
+ (encode-universal-time 14 23 12 1 3 2005)))
+ (assert (equal (coerce (nth 6 res) 'list)
+ '(#x11 #x22 #x33 #x44 #x55 #x66 #x77 #x88 #x99 #x00)))
+ (assert (equal (nth 7 res) (make-string 200 :initial-element (code-char 1234))))
+ (let ((a (caar (exec-query con "select t_blob from type_test where id =1"))))
+ (assert (equalp a (make-array 100000 :element-type '(unsigned-byte 8) :initial-element 33))))
+ (let ((b (caar (exec-query con "select t_clob from type_test where id=1"))))
+ (assert (equal b (make-string 1000001 :initial-element #\o))))
+
+ (let ((c (caar (exec-query con "select t_nclob from type_test where id=1"))))
+ (assert (equal c (make-string 1234567 :initial-element (code-char 3217))))))
+
(commit con))
-
-
-
-(defun ora-drop-test-proc (con proc)
- (unless (zerop (caar (exec-query con (format nil "select count(*)
- from user_objects where object_name='~A'" proc))))
- (exec-command con (format nil "drop procedure ~A" proc))))
-
(defun ora-test1 (con)
@@ -200,4 +238,5 @@
;; works only with oracle 9 ?
;; this does not work. mybe with the oracle odbc driver?
+;; it works with oracle 10gr2
(defun ora-test8 (con)
(ignore-errors (exec-command con "drop table testtab99"))
@@ -208,5 +247,5 @@
(exec-prepared-update stm 1 str))
(let ((res (exec-query con "select txt from testtab99 where id =1")))
- (assert (equal (list str) res)))))
+ (assert (equal (list str) (first res))))))
@@ -244,3 +283,25 @@
-
+(defun ora-test12 (con)
+ (ora-drop-test-proc con "TEST99")
+ (exec-command con (fix13 "create procedure test99 (a in out nvarchar2 ,b in out nvarchar2) as
+ x nvarchar2(1000);
+ begin x:=a; a:=b; b:=x; end;"))
+ (with-prepared-statement (stm con "{call test99(?,?)}"
+ '(:unicode-string :inout)
+ '(:unicode-string :inout))
+ (let ((str1 (make-funny-string 700 (coerce (list (code-char 2341) (code-char 2347) #\a) 'vector ) ))
+ (str2 (make-funny-string 900 (coerce (list (code-char 2341) (code-char 2347) #\a) 'vector ))))
+
+ (let ((res (exec-prepared-command stm str1 str2)))
+ (assert (equal res (list str2 str1)))))))
+
+(defun ora-test13 (con)
+ (ora-drop-test-table con "TESTTAB99")
+ (exec-command con "create table testtab99 (x integer,y varchar2(200))")
+ (multiple-value-bind (rc res params)
+ ;; if columns x and y are set by triggers they can also be retrieved by this method
+ (exec-sql con "insert into testtab99 (x,y) values(?+12,?||'a') returning x,y into ?,?" 13 "a" '(nil :integer :out) '(nil :string :out) )
+ (assert (= rc 1))
+ (assert (equal res nil))
+ (assert (equal (list 25 "aa") params))))
Index: 64-bit/src/test/test-sql-server.lisp
===================================================================
--- 64-bit/src/test/test-sql-server.lisp (revision 64-bit,1)
+++ 64-bit/src/test/test-sql-server.lisp (revision 64-bit,2.1.3)
@@ -469,6 +469,36 @@
-
-
-
-
+(defun ss-test23 (con)
+ (ss-drop-test-proc con "test99")
+ (exec-command con "
+ create procedure test99
+ @p1 integer,
+ @p2 varchar(200),
+ @p3 int out,
+ @p4 varchar(2000) out as
+ begin
+ set @p3=3*@p1;
+ set @p4='a'+ @p2 + '#'+ @p2 +'x'
+ select @p3 as a,@p4 as b;
+ select @p4 as bb,@p3 as aa;
+ end")
+ (let* ((teststr "abcdefghijklmnopqrstuvwxyz")
+ (testint 12345678)
+ (p4 (format nil "a~A#~Ax" teststr teststr))
+ (p3 (* 3 testint)))
+ (multiple-value-bind (c resultsets params)
+ (exec-sql con "{call test99 (?,?,?,?)}"
+ testint teststr '(nil :integer :out) '(nil :string :out))
+ (assert (equal params (list p3 p4)))
+ (let* ((res1 (first resultsets))
+ (res2 (second resultsets))
+ (row1 (first (first res1)))
+ (row2 (first (first res2))))
+
+ (assert (equal row1 (list p3 p4)))
+ (assert (equal row2 (list p4 p3)))
+ (assert (equal (second res1) '("a" "b")))
+ (assert (equal (second res2) '("bb" "aa")))))))
+
+
+