Changeset unicode,5 for unicode


Ignore:
Timestamp:
02/03/2008 08:14:49 PM (18 years ago)
Author:
raverkamp
revision id:
svn-v3-trunk1:1c22b0a8-4d0b-0410-a296-af6a2e6f35e3:plain-odbc%2Ftrunk:10
Message:

adding exec-sql, changes to documentation, more tests

Location:
unicode
Files:
1 added
1 deleted
12 edited

Legend:

Unmodified
Added
Removed

  • unicode/doc/documentation.html

    r4 r5  
    55    <title>Plain-odbc Documentation</title>
    66  </head>
    7 
    87  <body>
    98    <h1>plain-odbc documentation</h1>
    … …  
    1211      This is the version of plain-odbc which I am using right now.
    1312      The API could stand some improvements, currently it is rather
    14       simple. Hopefully it suffices for many uses. I thought I make
    15       the current version available before I make my mind up about
    16       another API.
     13      simple. But I think it is good enough for many uses.
     14      A higher level API is not a goal.
    1715    </p>
    1816    <p>
    … …  
    2119        ODBC documentation from Microsoft</a>.
    2220    </p>
    23     <h2>Platforms, not up to date</h2>
    24     <p>
    25       Plain-odbc uses CFFI to interface to the odbc libaries. I have tested it on
    26       Windows LispWorks Personal Edition (4.4) and
    27       CLISP 2.38. I am too lazy to download the new version of
    28       an "Allegro CL Trial Edition", but I am confident that this should also work.
    29       On Windows ODBC connections to Oracle and SQL-Server work.
    30       On Linux plain-odbc has been tested with CLISP and MySQL.
    31     </p>
    32    
     21 <h3>Platforms</h3>
     22    <p>
     23      Plain-odbc uses CFFI to interface to the ODBC libaries.
     24      The development platform ist clisp on Windows XP.
     25      On this system accessing Microsoft SQL-Server, Oracle 10g and MySQL 5.0 works.
     26      I do not expect big problems with other databases which have an ODBC driver.
     27      If there are problems they can also originate from the implementation of the
     28      ODBC driver, e.g. MyODBC does not support out parameters.
     29      At one time plain-odbc worked on Windows with LispWorks Personal Edition (4.4)
     30      and Allegro.
     31      On Linux it worked with CMUCL and MySQL. Since the interface to the ODBC library
     32      is done with
     33      CFFI, plain-odbc should still with on these platforms/systems.
     34      </p>
     35    <p>
     36      David Owen made the necessary changes to the code to make it run on
     37      64-bit Linux CMUCL and MySQL.
     38    </p>
    3339    <h2> Using plain-odbc, Examples </h2>
    34     You must load plain-odbc into lisp. plain-odbc is an asdf module,
     40    You must load plain-odbc into lisp. Plain-odbc is an asdf module,
    3541    so you need asdf. Make sure that asdf is able to find CFFI and plain-odbc.
    3642    <pre>(asdf:oos 'asdf:load-op :plain-odbc)
    … …  
    7581    Oracle does not really have integer columns, integer is just a short hand
    7682    for <tt>number(37,0)</tt>, and in a query this is returned as decimal.
    77     And plain-odbc converts decimals to doubles.
     83    And plain-odbc converts decimals to doubles. 
    7884    <pre>
    7985[9]> (exec-update *con* "update test1 set y=? where x=?" "text2" 1)
    … …  
    223229      actual parameter.
    224230    </p>
     231    <p><b>Note: MySql does not support out and in/out parameters. There are no
     232      return parameters. A citation from the documentation of MySql:</b>
     233</p>
     234      <p><em>
     235For 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.
     236</em><tt><br>
     237mysql_query(mysql, "CALL p1(@param1, @param2)");<br>
     238mysql_query(mysql, "SELECT @param1, @param2");<br>
     239result = mysql_store_result(mysql);<br>
     240row = mysql_fetch_row(result);<br>
     241mysql_free_result(result);<br>
     242</tt>
     243
     244
     245      </p>
     246
    225247    <p>
    226248      The function  <tt>prepare-statement</tt> is called with the parameters
    … …  
    236258    Currently the only parameter is the maximal length parameter for
    237259    the string and binary (= Oracle's raw) datatypes. Instead of a list for
    238     a parameter description only the name of the parameter type can be given. This is
    239     equivalent to a list with two elements: the symbol and the direction <tt>:in</tt>.
     260    a parameter description only the name of the parameter type can be given.
     261    This is equivalent to a list with two elements: the symbol and the direction <tt>:in</tt>.
    240262    The following parameter types ares supported:
    241263  </p>
    … …  
    337359        the value returns true then the value is passed as :date. Of course
    338360        <tt>*date-datatype-to-universal-time*</tt> must be able to convert
    339         the value universal time.
     361        the value to universal time.
    340362    </ul>
    341363
    … …  
    387409    <p>
    388410      <br><b>[Function]</b><br>
    389       <tt>connect-sql-server <i>server database</i> &optional <i>user password</i></tt><br>
    390       Connect to sql server named <i>server</i>, the initial database is <i>database</i>.
    391       If <i>user</i> and <i>password</i> are supplied the connection is made with sql server
    392       authentication, if the parameters are not supplied then the connection is made with
    393       integrated security. The name of the template odbc datasource for this function is
    394       <tt>default-sql-server-dsn</tt>.
    395     </p>
    396     <p>
     411        <tt>connect-sql-server <i>server database</i> &optional <i>user password</i></tt><br>
     412          Connect to sql server named <i>server</i>, the initial database is <i>database</i>.
     413          If <i>user</i> and <i>password</i> are supplied the connection is made with sql server
     414          authentication, if the parameters are not supplied then the connection is made with
     415          integrated security. The name of the template odbc datasource for this function is
     416          <tt>default-sql-server-dsn</tt>.
     417      </p>
     418      <p>
    397419      <br><b>[Function]</b><br>
    398420      <tt>connect-oracle <i>server user password</i></tt><br>
    … …  
    401423      <tt>default-oracle-dsn</tt>.
    402424    </p>
    403     <p>
    404       <br><b>[Function]</b><br>
    405       <tt>connect-access <i>filename</i></tt><br>
     425      <p>
     426        <br><b>[Function]</b><br>
     427            <tt>connect-access <i>filename</i></tt><br>
    406428      Connect to the access database (a .mdb file) with name filename.
    407429      The name of the template odbc datasource for this function is
    408430      <tt>default-access-dsn</tt>.
    409431    </p>
    410      
     432      <p>
     433        <br><b>[Function]</b><br>
     434            <tt>connect-mysql <i>server database user password</i></tt><br>
     435         Connect to the MySql server on <i>server</i> connecting as user
     436        <i>user</i> with password <i>password</i>. The default database is
     437       <i>database</i>. If database is <tt>NIL</tt> no database is chosen.
     438        The name of the template odbc datasource for this function is
     439        <tt>default-mysql-dsn</tt>.
     440      </p>
     441
    411442    <h3>Working with Connections</h3>
    412443    <p>
    … …  
    428459     If a column is a LOB (BLOB or CLOB) then the data is retrieved
    429460      with the ODBC function SQLGetData. This has the consequence that
    430       thr following columns must also be retrieved with SQLGetData,
     461      the following columns must also be retrieved with SQLGetData,
    431462      otherwise an error is raised by the driver.
    432463      Retrieving the following columns via
    … …  
    440471      But be carefull with  the conversion format (1.23 vs. 1,23).
    441472    </p>
     473      <p>
     474     <br><b>[Function]</b><br>
     475      <tt>exec-query*<i>connection sqlstring parameters</i></tt><br>
     476      The same as <tt>exec-query</tt>, but the ODBC parameters are passed as a list.
     477      </p>
    442478    <p>
    443479      <br><b>[Function]</b><br>
    … …  
    447483      list of parameter descriptions.
    448484    </p>
     485     <p>
     486      <br><b>[Function]</b><br>
     487      <tt>exec-update*<i>connection sqlstring parameters</i></tt><br>
     488      The same as <tt>exec-update</tt>, but the ODBC parameters are passed as a list.
     489    </p>
    449490    <p>
    450491      <br><b>[Function]</b><br>
    … …  
    453494      <i>parameters</i> is a list of parameter descriptions.
    454495      Returns the list of out and in-out parameters.
    455     </p>
     496      </p>
     497      <p>
     498      <br><b>[Function]</b><br>
     499      <tt>exec-command*<i>connection sqlstring parameters</i></tt><br>
     500      The same as <tt>exec-command</tt>, but the ODBC parameters are passed as a list.
     501      </p>
     502
    456503    <p>
    457504      <br><b>NOTE</b><br>
    … …  
    460507      One can execute a select statement with <tt>exec-update</tt> and
    461508      <tt>exec-command</tt>. But the command for <tt>exec-query</tt>
    462       must return a resultset.
    463     </p>
     509      must return a resultset. The following functions offers the functionality
     510      of all three functions:
     511    </p>
     512     <br><b>[Function]</b><br>
     513      <tt>exec-sql <i>connection sqlstring &amp;rest parameters</i></tt></br>
     514      Execute an sql statement (select, dml or stored procedure call) on <i>connection</i>
     515      with sql <i>sqlstring</i>. <i>parameters</i> is a list of parameter descriptions.
     516        This function returns three values
     517        <ul>
     518          <li> the number of affected records, i.e. what is normally returend by
     519            <tt>exec-update</tt>.</li>
     520            <li> the list of the resultsets, each resultset is a list of two elements:
     521            the list of rows and a list of the column names.</li>
     522          <li>the list of returned parameters</li>         
     523        </ul>
     524      </p>
     525    <p>
     526      <br><b>[Function]</b><br>
     527          <tt>exec-sql*<i>connection sqlstring parameters</i></tt><br>
     528            The same as <tt>exec-sql</tt>, but the ODBC parameters are passed as a list.
     529    </p>
     530   
    464531    <P>
    465532      <br><b>[Function]</b><br>

  • unicode/doc/notes.html

    r4 r5  
    11<html>
    2 <!-- ;;;-*- Mode: HTML; -*- -->   
     2<!-- -*- Mode: HTML; -*- -->   
     3  <head>
     4    <title>Notes on Plain-Odbc</title>
     5  </head>
     6<body>
    37    <h3>Notes</h3>
    4    
     8    <p> This documents contains some observations and pitfalls encountered
     9        when using different drivers and databases.
     10    </p>
    511    <h4> driver-connect </h4>
    612    Using driver-connect one does not have to create an ODBC datasource for every
    … …  
    4046   
    4147   
    42     <h4> performances </h4>
     48    <h4> performance </h4>
    4349    It seems that with clisp storing and retrieving C datatypes from memory take a lot time.
    4450    This should be possible without consing, maybe I have to change my clisp FFC module.
    … …  
    9096MYODBC (3.51?) does not return unicode character data as datatype SQL_WVARCHAR. If for SQL_VARCHAR data the return datatype is set to SQLWCHAR, the length in the indicator is 0. It seems that the buffer is also empty (= #x000000000 ...). There is some talk about better support for unicode in another version (3.52?).
    9197
     98<h4>
     99<p>
     100More Information about Oracle ODBC Driver</h4>
     101There is documentation for the  Oracle  ODBC driver, it is at</p>
     102<tt>
     103Oracle® Database Administrator's Reference<br>
     10410g Release 2 (10.2) for UNIX-Based Operating Systems<br>
     105Part Number B15658-05<br>
     106G Using Oracle ODBC Driver<br>
     107</tt>
     108or better under the link
     109<a href="http://download-uk.oracle.com/docs/cd/B19306_01/server.102/b15658/app_odbc.htm"> G Using Oracle ODBC Driver</a>, but this can change any time.
     110
    92111<h4>Oracle 9.2 and unicode</h4>
    93112<p>
    94 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.
     113I can not make Oracle return unicode. I am using a 9.2 DB I have created a nchar column which is a
     114unicode datatype for 9.2.
    95115<p>
    96116I am using the oracle driver. There is a workaround tab where one can force the driver to
    … …  
    99119Only selecting from  NLS_SESSION_PARAMETERS returns a 16bit charcater.
    100120Or do I have this problem since NLS_CHARACTERSET=WE8ISO8859P15?
     121<h4> Oracle 10gR2 and unicode</h4>
     122It works now (with Oracle driver!):
     123<pre>
     124[13]> (schar (caar (exec-query *con* "select nCHR(232) from dual")) 0)
     125
     126#\LATIN_SMALL_LETTER_E_WITH_GRAVE
     127[14]>
     128
     129[16]> (char-code (schar (caar (exec-query *con* "select ? from dual"  (list (string (code-char 1234)) :unicode-string))  ) 0))
     130
     1311234
     132</pre>
     133
    101134
    102135<h4>Microsoft ODBC driver for Oracle</h4>
    … …  
    107140
    108141<h4>Oracle and ref cursors</h4>
    109 This is easy with the oracle odbc driver and an 9.2 database.
     142This works with 9.2 and 10g and 10gR2. Make sure that the ODBC datasource is
     143configured correctly. On the "Oracle ODBC Driver Configuration" window check the
     144checkbox with label "Enable Result Sets".<br>
    110145Example:
    111146<pre>
    … …  
    127162(with-prepared-statement (stm con
    128163                                "{call test99_pkg.test_cursor(?,?)}"
    129                                 '((:string :in )))
     164                                '(:string :in ))
    130165    (let ((str "just a string"))
    131       (exec-prepared-query stm (list str))))
    132 </pre>
    133 Note that the cursor parameter must be declared in/out. If a parameter ist supplied for the cursor parameter, it still works. <em>This needs more investigations.</em>
    134 
    135 <h4>Oracle TIMESTAMP datatype in 9.2, 10g</h4>
     166      (exec-prepared-query stm str)))
     167</pre>
     168Note that the cursor parameter must be declared in/out.
     169If a parameter ist supplied for the cursor parameter, it still works.
     170</em>
     171<em>This needs more investigations.</em>
     172
     173<h4>Oracle TIMESTAMP datatype</h4>
     174<h5> 9.2, 10g</h4>
    136175Windows: For the Oracle-Driver, queries on TIMESTAMP columns return SQL_NULL_TYPE. Normally this would be retrieved
    137176as String. But the program coredumps at the first fetch.
    … …  
    140179At least we prevent the coredump of the Oracle driver.<br>
    141180I am pretty sure that this is a driver bug, Microsoft Access coredumps as well in similar situations.
    142 
    143 
    144 <h4>MYSQL</h4>
     181<h5>10g R2</h5>
     182It works now, a timestamp column is retrieved as SQL_TIMESTAMP.
     183Of course the sub second precision is not supported.
     184
     185<h4>MySQL</h4>
    145186This is not one would expect!
    146187<pre>
    147 mysql> create view bla as select  date_add('2007-8-1',interval 1 day) as a;
     188MySQL> create view bla as select  date_add('2007-8-1',interval 1 day) as a;
    148189Query OK, 0 rows affected (0.01 sec)
    149190
    150 mysql> desc bla
     191MySQL> desc bla
    151192    -> ;
    152193+-------+---------------+------+-----+---------+-------+
    … …  
    159200how to do it right:
    160201<pre>
    161 mysql> create view bla2 as select  date_add(cast('2007-8-1' as datetime),interval 1 day) as a;
     202MySQL> create view bla2 as select  date_add(cast('2007-8-1' as datetime),interval 1 day) as a;
    162203Query OK, 0 rows affected (0.00 sec)
    163204
    164 mysql> desc bla2;
     205MySQL> desc bla2;
    165206+-------+----------+------+-----+---------+-------+
    166207| Field | Type     | Null | Key | Default | Extra |
    … …  
    179220server settings:
    180221<pre>
    181 mysql> select cast(cast('12345678901' as decimal) as char) as a, cast(cast('1234567890' as decimal) as char) as b;
     222MySQL> select cast(cast('12345678901' as decimal) as char) as a, cast(cast('1234567890' as decimal) as char) as b;
    182223+------------+------------+
    183224| a          | b          |
    … …  
    191232Division by zero is handled, but only for an insert:
    192233<pre>
    193 mysql> set @a=1;
     234MySQL> set @a=1;
    194235Query OK, 0 rows affected (0.00 sec)
    195236
    196 mysql> set @b=0;
     237MySQL> set @b=0;
    197238Query OK, 0 rows affected (0.00 sec)
    198239
    199 mysql> select @a/@b;
     240MySQL> select @a/@b;
    200241+-------+
    201242| @a/@b |
    … …  
    2052461 row in set, 1 warning (0.00 sec)
    206247
    207 mysql> insert into blu select @a/@b;
     248MySQL> insert into blu select @a/@b;
    208249ERROR 1365 (22012): Division by 0
    209250</pre>
    210251
     252<h5>Handling of numbers</h5>
     253<pre>
     254[130]> (exec-query *con* "select cast(1.5e0/3.9e0 as char(200)) as a")
     255
     256(("0.38461538461538")) ;
     257("a")
     258[131]> (exec-query *con* "select cast(cast(1.5e0/3.9e0 as decimal(40,20)) as char(200)) as a")
     259
     260(("0.38461538461538460000")) ;
     261("a")
     262</pre>
     263In clisp on x86 I get:
     264<pre>
     265[132]> (/ 1.5d0 3.9d0)
     266
     2670.38461538461538464d0
     268</pre>
     269With sql server I get the same value, as with clisp.
     270<p>
     271And another example :
     272<pre>
     273MySQL> select 1e14/7e0,1e14/7e0-14285714285714;
     274+----------------+-------------------------+
     275| 1e14/7e0       | 1e14/7e0-14285714285714 |
     276+----------------+-------------------------+
     277| 14285714285714 |              0.28515625 |
     278+----------------+-------------------------+
     2791 row in set (0.00 sec)
     280</pre>
     281The decimal expansion of 1/7 is periodic, so the digits 0.285 are correct. Thus
     282MySQL uses the precision of double, but does not return all digits.
     283
     284<h3>Parameters</h3>
     285<p>
     286As mentioned in the documentation, MySQL does not support out and in/out
     287parameters for sql statements. As the documentation of MySQL suggest
     288one should declare variables, pass them as parameters to the stored
     289procedures. After the procedure call one get there contents with a select
     290statement, example: <tt>select @param1 as param1,@param2 as param2</tt>.
     291
     292</p>
     293<p>
     294The problem with variables on MySQL is that one can only set them. It is
     295not possible to declare a datatype for them.
     296Another option is to select the parameters directly in the stored procedure.
     297Thus instead of having out or in/out parameters, the procedure returns
     298return values as a result set. Note that <tt>exec-query<tt> accepts parameters
     299and can return more than one result set. One example, assume
     300<tt>*con*</tt> is a MySQL connection.
     301<pre>
     302[33]>  (exec-command *con* "
     303    create procedure test99(a1 varchar(200),b1 int,c1 date)
     304    begin
     305    declare a2 varchar(200);
     306    declare b2 int;
     307    declare c2 date;
     308     set a2=concat(a1,'x');
     309      set b2=b1+3;
     310      set c2=c1+ interval 1 day;
     311      select a2 as a2,b2 as b2, c2 as c2;
     312    end;")
     313
     314
     315[34]> (exec-query *con* "call test99(?,?,?)" "abc"
     316                          (list 12 :integer) (list  (encode-universal-time 12 3 5 12 11 2007) :date))
     317
     318(("abcx" 15 3403897200)) ;
     319("a2" "b2" "c2")
     320[35]>
     321</pre>
     322</body>
    211323</html>

  • unicode/license.txt

    r1 r5  
    1 This system contains codefrom Paul Meurer, Joerg Hoehle and Roland Averkamp.
    21
     2This system contains code from Paul Meurer and Roland Averkamp.
     3
     4David Owen made the necessary adjustments to the code to
     5make it run on 64-bit Linux.
    36
    47This system contains code from Paul Meurer:
    58the FFC system was written by him and also
    6 the the lower level parts of the system:
    7 src/odbc/codbc-constants.lisp
     9the lower level parts of the system:
     10src/odbc/odbc-constants.lisp
    811src/odbc/odbc-ff-interface.lisp
    912src/odbc/ odbc-functions.lisp
    … …  
    3437
    3538
    36 The uffi system is written by Goerg Hoehle
    37 this is the file src/uff-clisp/uffi.lisp
    38 And this is his license
    39 (c) 2004-2005 Joerg Hoehle
    40 Copyright: Allegro's LispLGPL (LLGPL)
    41 
    42 
    4339The upper parts of the system are written by me (Roland Averkamp)
    4440and carry my copyright notice. For my code I use the new BSD license.

  • unicode/plain-odbc.asd

    r1 r5  
    99                         (:file "odbc-constants")
    1010                         (:file "global")
    11                          (:file "cffi-support")
     11                         (:file "ffi-support")
    1212                         (:file "odbc-ff-interface")
    1313                         (:file "odbc-functions")

  • unicode/src/odbc/odbc-functions.lisp

    r3 r5  
    4747;; TODO: Why doesn't this use with-temporary-allocations? -dso
    4848(defun handle-error (henv hdbc hstmt)
    49   (let
     49  (with-temporary-allocations
    5050      ((sql-state (alloc-chars 256))
    5151       (error-message (alloc-chars #.$SQL_MAX_MESSAGE_LENGTH))
    … …  
    6363     (cffi:mem-ref error-code 'sql-integer))))
    6464
    65 
    66 ; test this: return a keyword for efficiency
    67 ;; rav,
    68 ;; problem: calling SQLError clears the error state
    69 ;#+ignore
    7065(defun sql-state (henv hdbc hstmt)
    7166  (with-temporary-allocations
    … …  
    8378
    8479(defun error-handling-fun (result-code henv hdbc hstmt)
    85   ;; *** is this a bug in allegro or in my code??
    86   ;#+allegro (setf result-code (short-to-signed-short result-code))
    87 
    8880  (case result-code
    89     (#.$SQL_SUCCESS (values result-code nil))
     81    ((#.$SQL_SUCCESS #.$SQL_NO_DATA_FOUND) (values result-code nil))
    9082    ((#.$SQL_SUCCESS_WITH_INFO #.$SQL_ERROR)
    9183      (multiple-value-bind (error-message sql-state msg-length error-code)
    … …  
    10294                 :sql-state sql-state
    10395                 :error-code error-code))))
    104    
     96    ; this can happen, using  a wrong handle
    10597    (#.$SQL_INVALID_HANDLE
    10698      (values result-code
    10799              (make-condition 'sql-error :error-message "[ODBC error] Invalid handle")))
     100    ;; maybe this should raise an error immediately
    108101    (#.$SQL_STILL_EXECUTING
    109102      (values result-code
    110103              (make-condition 'sql-error :error-message"[ODBC error] Still executing")))
    111     (otherwise (values result-code nil))
     104    (#.$SQL_NEED_DATA
     105     (values result-code nil))
     106
     107    ;; rav: hope above are all result codes I know
     108    (otherwise (error "unknown result of odbc execution: ~A" result-code))
    112109    ))
    113110
    … …  
    115112;;; rav:
    116113;;; but the remaining macro is still large
    117 #+ignore
    118 (defmacro with-error-handling ((&key henv hdbc hstmt (print-info t))
     114
     115(defmacro with-error-handling ((&key henv hdbc hstmt)
    119116                                   odbc-call &body body)
    120   (declare (ignore print-info))
    121117  (let ((condition-var (gensym))
    122118        (result-code (gensym)))
    … …  
    129125
    130126
    131 ;;; rav:
    132 ;; the original macro
    133 #-ignore
    134 (defmacro with-error-handling ((&key henv hdbc hstmt (print-info t))
    135                                    odbc-call &body body)
    136   (let ((result-code (gensym)))
    137     `(let ((,result-code ,odbc-call))
    138        ;; *** is this a bug in allegro or in my code??
    139        ;#+allegro (setf ,result-code (short-to-signed-short ,result-code))
    140        (case ,result-code
    141          (#.$SQL_SUCCESS
    142           (progn ,result-code ,@body))
    143          (#.$SQL_SUCCESS_WITH_INFO
    144           (when ,print-info
    145             (multiple-value-bind (error-message sql-state)
    146                                  (handle-error (or ,henv (cffi:null-pointer))
    147                                                (or ,hdbc (cffi:null-pointer))
    148                                                (or ,hstmt (cffi:null-pointer)))
    149               (warn "[ODBC info] ~a state: ~a"
    150                     ,result-code error-message
    151                     sql-state)))
    152           (progn ,result-code ,@body))
    153          (#.$SQL_INVALID_HANDLE
    154           (error "[ODBC error] Invalid handle"))
    155          (#.$SQL_STILL_EXECUTING
    156           (error "[ODBC error] Still executing"))
    157          (#.$SQL_ERROR
    158           (multiple-value-bind (error-message sql-state)
    159                                (handle-error (or ,henv (cffi:null-pointer))
    160                                              (or ,hdbc (cffi:null-pointer))
    161                                              (or ,hstmt (cffi:null-pointer)))
    162             (error "[ODBC error] ~a; state: ~a" error-message sql-state)))
    163          (otherwise
    164            (progn ,result-code ,@body))
    165          ))))
    166 
    167 
    168127(defun %new-environment-handle ()
    169128  (cffi:with-foreign-object (phenv 'sql-h-env)
    … …  
    196155       (progn ,@body)
    197156       (%free-statement ,hstmt :drop))))
    198 
    199 ;;; rav: ignored
    200 #+ignore
    201 (defmacro %with-transaction ((henv hdbc) &body body)
    202   (let ((successp (gensym)))
    203     `(let ((,successp nil))
    204        (unwind-protect
    205          (prog1
    206            (progn ,@body)
    207            (setf ,successp t))
    208          (with-error-handling (:henv ,henv :hdbc ,hdbc)
    209            (SQLTransact
    210             ,henv ,hdbc
    211             (if ,successp $SQL_COMMIT $SQL_ROLLBACK)))))))
    212157
    213158;; functional interface
    … …  
    595540  (declare (type (integer 0) column-nr))
    596541  (with-error-handling
    597       (:hstmt hstmt :print-info nil)
     542      (:hstmt hstmt)
    598543      (SQLGetData hstmt (if (eq column-nr :bookmark) 0 (1+ column-nr))
    599544                  c-type data-ptr precision out-len-ptr)))
    … …  
    606551
    607552(defun %sql-param-data (hstmt param-ptr)
    608   (with-error-handling (:hstmt hstmt :print-info t) ;; nil
     553  (with-error-handling (:hstmt hstmt)
    609554      (SQLParamData hstmt param-ptr)))
    610555
    … …  
    612557(defun %sql-put-data (hstmt data-ptr size)
    613558  (with-error-handling
    614       (:hstmt hstmt :print-info t) ;; nil
     559      (:hstmt hstmt )
    615560      (SQLPutData hstmt data-ptr size)))
    616561

  • unicode/src/odbc/odbc-main.lisp

    r4 r5  
    106106
    107107
    108 ;;; fixme, is this correct?
    109108(defmethod print-object ((connection odbc-connection) s)
    110109  (format s "#<~A SERVER=~S DBMS=~S USER=~S>"
    … …  
    310309         (error "not able to deduce parameter specification for ~A" obj)))))
    311310
    312 (defun exec-sql (connection sql parameter-list)
     311(defun exec-sql-statement (connection sql parameter-list)
    313312  (let ((query (make-query connection)))
    314313    (unwind-protect
    … …  
    358357        )))
    359358
     359(defun exec-sql* (connection sql parameter-list)
     360  (exec-sql-statement connection sql parameter-list))
     361
     362(defun exec-sql (connection sql &rest parameter-list)
     363  (exec-sql* connection sql parameter-list))
     364
     365
     366
    360367(defun exec-query* (connection sql parameter-list)
    361368  (multiple-value-bind (rows result-sets out-params)
    362       (exec-sql connection sql parameter-list)
     369      (exec-sql-statement connection sql parameter-list)
    363370    (declare (ignore rows) (ignore out-params))
    364371    (let ((res nil))
    … …  
    373380(defun exec-update* (connection sql parameter-list)
    374381  (multiple-value-bind (rows result-sets out-params)
    375       (exec-sql connection sql parameter-list)
     382      (exec-sql-statement connection sql parameter-list)
    376383    (declare (ignore result-sets out-params))
    377384    rows))
    … …  
    382389(defun exec-command* (connection sql parameter-list)
    383390  (multiple-value-bind (rows result-sets out-params)
    384       (exec-sql connection sql parameter-list)
     391      (exec-sql-statement connection sql parameter-list)
    385392    (declare (ignore rows result-sets))
    386393    (values-list out-params)))

  • unicode/src/odbc/odbc-utilities.lisp

    r3 r5  
    4444                     )))
    4545
    46 (defun connect-mysql (server user password)
    47   (connect-generic :dsn *default-mysql-dsn*
    48                    :server server :uid user :pwd password))
     46(defun connect-mysql (server database user password)
     47  (apply 'connect-generic
     48         (append
     49          (list :dsn *default-mysql-dsn*
     50                :server server :uid user :pwd password)
     51          (if database (list :database database) ())
     52         )))
     53
    4954
    5055

  • unicode/src/odbc/plain-odbc-package.lisp

    r4 r5  
    1414; #+mcl "CCL" #+cormanlisp "WIN32" "CFFI")
    1515  (:export
     16   "EXEC-SQL"
    1617   "EXEC-QUERY"
    1718   "EXEC-UPDATE"
    1819   "EXEC-COMMAND"
    1920
     21   "EXEC-SQL*"
    2022   "EXEC-QUERY*"
    2123   "EXEC-UPDATE*"
    … …  
    2628   "EXEC-PREPARED-UPDATE"
    2729   "EXEC-PREPARED-COMMAND"
    28    "FREE-STATEMENT"
    29    "CONNECT"
     30   "FREE-STATEMENT" 
     31   "CONNECT"   
    3032   ;"DRIVER-CONNECT"
    3133   "CONNECT-GENERIC"

  • unicode/src/test/readme.txt

    r2 r5  
    1717
    1818The tests are started with the function run-mysql-tests,run-oracle-tests
    19 run-sql-server-tests. These function take one parameter, an
    20 odbc connection to thecorresponding database.
     19and run-sql-server-tests. These function take one parameter, an
     20odbc connection to the corresponding database.
    2121
    2222[44]> (setf *con* (connect-oracle "ltrav1" "scott" "tiger"))

  • unicode/src/test/test-mysql.lisp

    r4 r5  
    1111
    1212(defun run-mysql-tests (con)
    13   (make-mysql-type-test con)
    14   (mysql-test1 con)
    15   (mysql-test2 con)
    16   (mysql-test3 con)
    17   (mysql-test4 con)
    18   (mysql-test5 con)
    19   (mysql-test6a con)
    20   (mysql-test6b con)
    21   (mysql-test7 con)
    22   (mysql-test9 con)
    23   (mysql-test10 con)
    24   (mysql-test15 con)
    25   (mysql-test20 con)
    26   (mysql-test22 con)
    27   (mysql-test23 con)
    28   (mysql-test23b con)
    29   )
     13  (dolist (sym '(
     14                 mysql-type-test
     15                 mysql-test1
     16                 mysql-test2
     17                 mysql-test3
     18                 mysql-test4
     19                 mysql-test5
     20                 mysql-test6a
     21                 mysql-test6b
     22                 mysql-test7
     23                 mysql-test9
     24                 mysql-test10
     25                 mysql-test15
     26                 mysql-test20
     27                 mysql-test22
     28                 mysql-test23
     29                 mysql-test23b
     30                 mysql-test24
     31                 mysql-test25
     32                 mysql-test26
     33                 mysql-test27
     34                 mysql-test28
     35                 ))
     36    (pprint sym)
     37    (funcall sym con)))
    3038
    3139(defparameter *mysql-type_test-ddl* " 
    … …  
    3846t_INT int,
    3947t_BIGINT bigint,
    40 t_float24 float(24),
    41 t_float53 float(53),
    4248t_float float,
    4349t_DOUBLE double,
    … …  
    6470)
    6571")
    66 (defun make-mysql-type-test (con)
     72(defun mysql-type-test (con)
    6773  (ignore-errors (exec-command con "drop table type_test"))
    6874  (exec-command con *mysql-type_test-ddl*)
    … …  
    7581  t_INT =987,
    7682  t_BIGINT =256*256*256*256 *256*256*256*127,
    77   t_float24 =9.67,
    78   t_float53 = 1.5/3.9,
    79   t_float =1.0/7.0,
    80   t_DOUBLE = 1.0/7.0,
     83  t_float =1.0e0/7.0e0,
     84  t_DOUBLE = 1.0e0/7.0e0,
    8185  t_decimal40_20 = '12345678901234567890.1234567890123456789',
    8286  t_dATE ='2004-6-25',
    … …  
    8690  t_YEAR        =1967,
    8791  T_char = 'abcdefghijkmlnop',
    88   t_varchar = 'abcdefghijklmnopqrstuvw',
     92  t_varchar = 'abcdefghijklmnopqrstuvw'
    8993/*  --  t_TINYBLOB = lpad('a',33000),
    9094  --  t_TINYTEXT lpad('a',33000),
    … …  
    9397  --  t_MEDIUMBLOB mediumblob,
    9498  --  t_MEDIUMTEXT mediumtext,
    95   t_LONGBLOB longblob, */
    96   t_LONGTEXT = lpad('a',33000,'x')
     99  --t_LONGBLOB longblob,
     100  --t_LONGTEXT = lpad('a',33000,'x')
    97101  where id =1
    98102")
    99103  (commit con)
    100   (let ((res (exec-query con "
     104   (let ((stm (prepare-statement
     105              con "update type_test set t_longblob =?, t_longtext=? where id =1"
     106              '(:blob :in) '(:clob :in))))
     107     (exec-prepared-update stm
     108                           (make-array 10000 :element-type '(unsigned-byte 8)
     109                                       :initial-element 33)
     110                           (make-string 100001 :initial-element #\o)))
     111   (commit con)
     112   (let ((res (exec-query con "
    101113    select t_tinyint,
    102114           t_smallint,
    … …  
    104116           t_int,
    105117           t_bigint,
    106            t_float24,
    107            t_float53,
    108118           t_float,
    109119           t_double,
    … …  
    115125           t_char,
    116126           t_varchar,
     127           t_longblob,
    117128           t_longtext
    118         from type_test where id=1
    119 ")))
    120     ;(pprint res)
    121     )
    122   (let ((stm (prepare-statement
    123               con "update type_test set t_longblob =?, t_longtext=? where id =1"
    124               '(:blob :in) '(:clob :in))))
    125     (exec-prepared-update stm
    126                           (make-array 10000 :element-type '(unsigned-byte 8)
    127                                       :initial-element 33)
    128                           (make-string 100001 :initial-element #\o)))
    129 (commit con))
     129        from type_test where id=1")))
     130     (assert (= (length res) 1))
     131     (setf res (first res))
     132     (assert (equal (nth 0 res) 1))
     133     (assert (equal (nth 1 res) 255))
     134     (assert (equal (nth 2 res) (* 256 256 127)))
     135     (assert (equal (nth 3 res) 987))
     136     (assert (equal (nth 4 res) (* 256 256 256 256  256 256 256 127)))
     137     ;; these are skipped since support for double in myslq is bad
     138     ;;(assert (equal (nth 5 res) (/  1 7.0)))
     139     ;;(assert (equal (nth 6 res) (/  1 7d0)))
     140     ;; skipped because we do not have decimal as a datatype
     141     (assert (equal (nth 7 res) 12345678901234567890.1234567890123456789d0))
     142     (assert (equal (nth 8 res) (encode-universal-time  0 0 0 25 6 2004)))
     143     (assert (equal (nth 9 res) (encode-universal-time  34 56 13 13 5 2004)))
     144     (assert (equal (nth 10 res)  "12:56:00"))
     145     ;; year is returend as  SQL_SMALLINT
     146     (assert (equal (nth 11 res)  1967))
     147     (assert (equal (nth 12 res) "abcdefghijkmlnop"))
     148     (assert (equal (nth 13 res) "abcdefghijklmnopqrstuvw"))
     149     (assert (equal (coerce (nth 14 res) 'list)
     150                    (coerce (make-array 10000 :element-type '(unsigned-byte 8)
     151                                        :initial-element 33 :adjustable t) 'list)))
     152     (assert (equal (nth 15 res) (make-string 100001 :initial-element #\o)))
     153     ))
     154
    130155
    131156
    … …  
    175200  (with-prepared-statement (stm con "insert into type_test (id,t_double) values(99,?)"
    176201                                '(:double :in))
    177     (exec-prepared-update stm 1.8))
     202    (exec-prepared-update stm 1.8d0))
    178203  (let ((res (exec-query con "select t_double+1 from type_test where id=99")))
    179204    (assert (<= (abs (- (caar res) 2.8d0)) 1d-7))))
    … …  
    431456   create procedure test99 (a decimal,b varchar(200))
    432457    begin
    433       select 3*a as a, 'x' + b +'y' as b, cast('2003-4-1' as datetime) as c;
     458      select 3*a as a, concat('x' , b ,'y') as b, cast('2003-4-1' as datetime) as c;
    434459      select uuid() as x,cast(123456789012345678 as signed) as y,cast('abcdefghijklmnop' as binary) as z;
    435460    end;")
    436   (with-prepared-statement
    437    (stm con "{call test99(?,?)}"
    438         '(:integer :in) '(:string :in))
    439    (multiple-value-bind (r1 c1 r2 c2) (exec-prepared-query stm 123456789 "abcdefghijklmn")
     461  (multiple-value-bind (r1 c1 r2 c2) (exec-query con "{call test99(?,?)" 123456789 "abcdefghijklmn")
    440462     
    441463     (assert (equal c1 '("a" "b" "c")))
    442464     (assert (equal c2 '("x" "y" "z")))
    443      (assert (equal r1 (list (* 3.0d   123456789) "xabcdefghijklmny"
     465     (assert (equal (first r1) (list (* 3.0d0   123456789) "xabcdefghijklmny"
    444466                             (encode-universal-time 0 0 0 1 4 2003))))
    445      (assert (equal (rest r2 ) (list 123456789012345678
    446                                      (map vector 'char-code "abcdefghijklmn")))))))
    447 
     467     (assert (equal (second (first r2 )) 123456789012345678 ))
     468     (assert (equal (coerce (third (first r2)) 'list) (coerce (map 'vector 'char-code "abcdefghijklmnop") 'list)))))
     469
     470(defun mysql-test26 (con)
     471  (mysql-drop-test-table con "testtab99")
     472  (exec-command con "create table testtab99 (id int,bla varchar(200))")
     473  (exec-update con "insert into testtab99 (id,bla) values(1,'bla1')")
     474  (exec-update con "insert into testtab99 (id,bla) values(2,'bla2')")
     475  (assert (equal (exec-update con "update testtab99 set bla=? where id=?" "bla100" 1) 1))
     476  (assert (equal (exec-update con "update testtab99 set bla=? where id=?" "bla100" 99) 0))
     477  (with-prepared-statement
     478   (stm con "update testtab99 set bla=? where id=?" :string :integer)
     479   (assert (equal (exec-prepared-update stm  "bla100" 1) 1))
     480   (assert (equal (exec-prepared-update stm  "bla100" 99) 0))
     481  ))
     482
     483(defun mysql-test27 (con)
     484  (mysql-drop-test-proc con "test99")
     485  (exec-command con "
     486    create procedure test99(a1 varchar(200),b1 int,c1 datetime)
     487    begin
     488    declare a2 varchar(200);
     489    declare b2 int;
     490    declare c2 datetime;
     491     set a2=concat(a1,'x');
     492      set b2=b1+3;
     493      set c2=c1+ interval 3 day;
     494      select a2 as a2,b2 as b2, c2 as c2;
     495    end;")
     496  (let* ((the-date (encode-universal-time 12 3 5 12 11 2007))
     497         (res (exec-query con "call test99(?,?,?)" "abc"
     498                          (list 12 :integer ) (list the-date :date)))
     499         (row (first res)))
     500    (assert (equal (first row) "abcx"))
     501    (assert (equal (second row) 15))
     502    (assert (equal (third row) (+ the-date (* 3 86400))))))
     503
     504(defun mysql-test28 (con)
     505  (mysql-drop-test-proc con "test99")
     506   (exec-command con "
     507    create procedure test99(a1 varchar(200),b1 int,c1 datetime)
     508    begin
     509    declare a2 varchar(200);
     510    declare b2 int;
     511    declare c2 datetime;
     512     set a2=concat(a1,'x');
     513      set b2=b1+3;
     514      set c2=c1+ interval 3 day;
     515      select a2 as \"a2\",b2 as \"b2\", c2 as \"c2\";
     516      select c2 as \"c2\", b2 as \"b2\",a2 as \"a2\";
     517
     518    end;")
     519   (let* ((the-date (encode-universal-time 12 3 5 12 11 2007)))
     520     (multiple-value-bind (co resultsets params)
     521         (exec-sql con "call test99(?,?,?)" "abc"
     522                   (list 12 :integer ) (list the-date :date))
     523       (let* ((rs1 (first resultsets))
     524              (rs2 (second resultsets))
     525              (rows1 (first rs1))
     526              (rows2 (first rs2))
     527              (cols1 (second rs1))
     528              (cols2 (second rs2))
     529              (row1 (first rows1))
     530              (row2 (first rows2)))
     531         (assert (equal (first row1) "abcx"))
     532         (assert (equal (second row1) 15))
     533         (assert (equal (third row1) (+ the-date (* 3 86400))))
     534
     535         (assert (equal (third row2) "abcx"))
     536         (assert (equal (second row2) 15))
     537         (assert (equal (first row2) (+ the-date (* 3 86400))))
     538         
     539         (assert (equal cols1 (list "a2" "b2" "c2")))
     540         (assert (equal cols2 (list "c2" "b2" "a2")))
     541         )
     542       )))
     543
     544
     545
     546 
     547
     548 

  • unicode/src/test/test-oracle.lisp

    r3 r5  
    1515                 ora-test6
    1616                 ora-test7
    17                  #+ignore  ;; unicode support does not work for oracle
    1817                 ora-test8
    1918                 ora-test9
    2019                 ora-test10
    2120                 ora-test11
     21                 ora-test12
    2222                 ))
    2323    (pprint sym)
    … …  
    3939  t_number number,
    4040  t_char char(2000) ,
    41   t_varchar varchar(4000),
     41  t_varchar varchar2(4000),
     42  t_nvarchar NVARCHAR2(200),
    4243  t_date date,
    4344  t_raw raw(2000),
    4445  t_blob blob,
    45   t_clob clob)
     46  t_clob clob,
     47  t_nclob nclob
     48  )
    4649")
    4750
     51
     52
     53(defun ora-drop-test-proc (con proc)
     54  (unless (zerop (caar (exec-query con (format nil "select count(*)
     55    from user_objects where object_name='~A'" proc))))
     56    (exec-command con (format nil "drop procedure ~A" proc))))
     57
     58(defun ora-drop-test-table (con proc)
     59  (unless (zerop (caar (exec-query con (format nil "select count(*)
     60    from user_objects where object_name='~A'" proc))))
     61    (exec-command con (format nil "drop table ~A" proc))))
     62
     63
    4864(defun oracle-type-test (con)
    49   (if (not (zerop (caar (exec-query con "select count(*) from user_tables where table_name ='TYPE_TEST'"))))
    50     (exec-command con "drop table type_test"))
     65  (ora-drop-test-table con "TYPE_TEST")
    5166  (exec-command con *oracle-type_test-ddl*)
    5267  (exec-update con "insert into type_test (id) values(1)")
    5368  (exec-update con "
    5469   update type_test set
    55       t_integer= 123456789012345677989,
     70      t_integer= 12345678901234,
    5671      t_number = 1.0/3.0,
    5772      t_char=rpad('1',1999),
    58       t_varchar =lpad('1',3999),
    59       t_date = sysdate,
     73      t_varchar =lpad('1',39),
     74      t_nvarchar = lpad(nchr(1234),200,nchr(1234)),
     75      t_date = to_date('1.3.2005 12:23:14','dd.mm.yyyy hh24:mi:ss'),
    6076      t_raw =hextoraw('11223344556677889900')
    6177    where id =1")
    62   (exec-query con "select * from type_test")
    6378  (let ((stm (prepare-statement
    64               con "update type_test set t_blob=?,t_clob=? where id =1"
    65               '(:blob :in) '(:clob :in))))
     79              con "update type_test set t_blob=?,t_clob=?,t_nclob=? where id =1"
     80              '(:blob :in) '(:clob :in) '(:UNICODE-CLOB :in))))
    6681  (exec-prepared-update
    6782   stm ;; sizes were 100000 and 100001
    6883   (make-array 100000 :element-type '(unsigned-byte 8) :initial-element 33)
    69    (make-string 1000001 :initial-element #\o)))
     84   (make-string 1000001 :initial-element #\o)
     85   (make-string 1234567 :initial-element (code-char 3217))))
     86  (let ((res (exec-query con "
     87      select id,t_integer,t_number,t_char,t_varchar,t_date,t_raw, t_nvarchar from type_test where id=1")))
     88    (assert (= (length res) 1))
     89    (setf res (first res))
     90    (assert (equal (nth 0 res) 1d0))
     91    (assert (equal (nth 1 res) 12345678901234d0))
     92    (assert (equal (nth 2 res) (/ 1d0 3)))
     93    ;;  t_char is of type char and therefor has always length 2000,
     94    ;; although we inserted a string of length 1999
     95    (assert (equal (nth 3 res)
     96                   (let ((a (make-string 2000 :initial-element #\space)))
     97                     (setf (schar a 0) #\1)
     98                     a)))
     99    (assert (equal (nth 4 res)
     100                   (let ((a (make-string 39 :initial-element #\space)))
     101                     (setf (schar a 38) #\1)
     102                     a)))
     103    (assert (equal (nth 5 res)
     104                   (encode-universal-time 14 23 12 1 3 2005)))
     105    (assert (equal (coerce (nth 6 res) 'list)
     106                   '(#x11 #x22 #x33 #x44 #x55 #x66 #x77 #x88 #x99 #x00)))
     107    (assert (equal (nth 7 res) (make-string 200 :initial-element (code-char 1234))))
     108    (let ((a (caar (exec-query con "select t_blob from type_test where id =1"))))
     109      (assert (equalp a (make-array 100000 :element-type '(unsigned-byte 8) :initial-element 33))))
     110    (let ((b (caar (exec-query con "select t_clob from type_test where id=1"))))
     111      (assert (equal b (make-string 1000001 :initial-element #\o))))
     112
     113    (let ((c (caar (exec-query con "select t_nclob from type_test where id=1"))))
     114      (assert (equal c (make-string 1234567 :initial-element (code-char 3217))))))
     115   
    70116  (commit con))
    71 
    72  
    73 
    74 (defun ora-drop-test-proc (con proc)
    75   (unless (zerop (caar (exec-query con (format nil "select count(*)
    76     from user_objects where object_name='~A'" proc))))
    77     (exec-command con (format nil "drop procedure ~A" proc))))
    78 
    79117
    80118(defun ora-test1 (con)
    … …  
    200238;; works only with oracle 9 ?
    201239;; this does not work. mybe with the oracle odbc driver?
     240;; it works with oracle 10gr2
    202241(defun ora-test8 (con)
    203242  (ignore-errors (exec-command con "drop table testtab99"))
    … …  
    208247    (exec-prepared-update stm 1 str))
    209248  (let ((res (exec-query con "select txt from testtab99 where id =1")))
    210     (assert (equal (list str) res)))))
     249    (assert (equal (list str) (first res))))))
    211250
    212251
    … …  
    244283
    245284       
    246 
     285(defun ora-test12 (con)
     286  (ora-drop-test-proc con "TEST99")
     287  (exec-command con  (fix13 "create procedure test99 (a in out nvarchar2 ,b in out nvarchar2) as
     288        x  nvarchar2(1000);
     289        begin x:=a; a:=b; b:=x; end;"))
     290  (with-prepared-statement (stm con "{call test99(?,?)}"
     291                                '(:unicode-string :inout)
     292                                '(:unicode-string :inout))
     293    (let ((str1 (make-funny-string 700  (coerce (list (code-char 2341) (code-char 2347) #\a) 'vector )  ))
     294          (str2 (make-funny-string 900   (coerce (list (code-char 2341) (code-char 2347) #\a) 'vector ))))
     295     
     296      (let ((res (exec-prepared-command stm str1 str2)))
     297        (assert (equal res (list str2 str1)))))))
     298 
     299(defun ora-test13 (con)
     300  (ora-drop-test-table con "TESTTAB99")
     301  (exec-command con "create table testtab99 (x integer,y varchar2(200))")
     302  (multiple-value-bind (rc res params)
     303      ;; if columns x and y are set by triggers they can also be retrieved by this method
     304      (exec-sql con "insert into testtab99 (x,y) values(?+12,?||'a') returning x,y into ?,?" 13 "a" '(nil :integer :out) '(nil :string :out) )
     305    (assert (= rc 1))
     306    (assert (equal res nil))
     307    (assert (equal (list 25 "aa") params))))

  • unicode/src/test/test-sql-server.lisp

    r1 r5  
    469469
    470470
    471 
    472    
    473      
    474              
     471(defun ss-test23 (con)
     472  (ss-drop-test-proc con "test99")
     473  (exec-command con "
     474     create procedure test99
     475     @p1 integer,
     476     @p2 varchar(200),
     477    @p3 int out,
     478    @p4  varchar(2000) out as
     479   begin
     480      set @p3=3*@p1;
     481      set @p4='a'+ @p2 + '#'+ @p2 +'x'
     482      select @p3 as a,@p4 as b;
     483      select @p4 as bb,@p3 as aa;
     484   end")
     485  (let* ((teststr "abcdefghijklmnopqrstuvwxyz")
     486        (testint 12345678)
     487        (p4 (format nil "a~A#~Ax" teststr teststr))
     488        (p3 (* 3 testint)))
     489   (multiple-value-bind (c resultsets params)
     490       (exec-sql con "{call test99 (?,?,?,?)}"
     491                 testint teststr '(nil :integer :out) '(nil :string :out))
     492     (assert (equal params (list p3 p4)))
     493     (let* ((res1 (first resultsets))
     494            (res2 (second resultsets))
     495            (row1 (first (first res1)))
     496            (row2 (first (first res2))))
     497
     498       (assert (equal row1 (list p3 p4)))
     499       (assert (equal row2 (list p4 p3)))
     500       (assert (equal (second res1) '("a" "b")))
     501       (assert (equal (second res2) '("bb" "aa")))))))
     502
     503
     504
Note: See TracChangeset for help on using the changeset viewer.