libs/sqlite/test.factor

   1 ! Copyright (C) 2005 Chris Double.
   2 !
   3 ! Redistribution and use in source and binary forms, with or without
   4 ! modification, are permitted provided that the following conditions are met:
   5 !
   6 ! 1. Redistributions of source code must retain the above copyright notice,
   7 !    this list of conditions and the following disclaimer.
   8 !
   9 ! 2. Redistributions in binary form must reproduce the above copyright notice,
  10 !    this list of conditions and the following disclaimer in the documentation
  11 !    and/or other materials provided with the distribution.
  12 !
  13 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  14 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  15 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  16 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  17 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  18 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
  19 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  20 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  21 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  22 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  23 !
  24 ! Test the sqlite interface
  25 !
  26 ! Create a test database like follows:
  27 !
  28 !   sqlite3 test.db < test.txt
  29 !
  30 !  Then run this file.
  31 USE: sqlite
  32 USE: kernel
  33 USE: io
  34 USE: prettyprint
  35
  36 : test.db "libs/sqlite/test.db" resource-path ;
  37
  38 : show-people ( statement -- )
  39   dup 0 column-text write " from " write 1 column-text . ;
  40
  41 : run-test ( -- )
  42   test.db sqlite-open
  43   dup "select * from test" sqlite-prepare
  44   dup [ show-people ] sqlite-each
  45   sqlite-finalize
  46   sqlite-close ;
  47
  48 : find-person ( name -- )
  49   test.db sqlite-open  ! name db
  50   dup "select * from test where name=?" sqlite-prepare ! name db stmt
  51   [ rot 1 swap sqlite-bind-text ] keep ! db stmt
  52   [ [ 1 column-text . ] sqlite-each ] keep
  53   sqlite-finalize
  54   sqlite-close ;
  55
  56 : find-all ( -- )
  57   test.db sqlite-open  ! db
  58   dup "select * from test" sqlite-prepare ! db stmt
  59   [ [ [ 0 column-text ] keep 1 column-text curry ] sqlite-map ] keep
  60   sqlite-finalize
  61   swap sqlite-close ;
  62
  63 : run-test2 ( -- )
  64   test.db sqlite-open
  65   dup "select * from test" sqlite-prepare
  66   dup [ show-people ] ;
  67
  68 run-test