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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • error-handling/src/test/test-mysql.lisp

    r2.1.2 r2.1.3  
    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 
Note: See TracChangeset for help on using the changeset viewer.