basis/db/sqlite/sqlite-tests.factor

   1 USING: accessors arrays db db.errors db.sqlite db.tuples
   2 db.types io.directories io.files.temp kernel layouts literals
   3 math.parser namespaces sequences sorting splitting tools.test ;
   4
   5 IN: db.sqlite.tests
   6
   7 : normalize ( str -- str' )
   8     " \n" split harvest " " join ;
   9
  10 ! delete-trigger-restrict
  11 ${
  12     {
  13         "CREATE TRIGGER fkd_TREE_NODE_NODE_ID_id "
  14         "BEFORE DELETE ON NODE "
  15         "FOR EACH ROW BEGIN "
  16         "SELECT RAISE(ROLLBACK, "
  17                       "'delete on table \"NODE\" violates "
  18                       "foreign key constraint \"fkd_TREE_NODE_NODE_ID_id\"') "
  19         "WHERE (SELECT NODE FROM TREE WHERE NODE = OLD.ID) IS NOT NULL; END;"
  20     } concat
  21 } [
  22     {
  23         { "table-name" "TREE" }
  24         { "table-id" "NODE" }
  25         { "foreign-table-name" "NODE" }
  26         { "foreign-table-id" "ID" }
  27     } [ delete-trigger-restrict ] with-variables
  28     normalize
  29 ] unit-test
  30
  31 ! insert-trigger
  32 ${
  33     {
  34         "CREATE TRIGGER fki_TREE_NODE_NODE_ID_id "
  35         "BEFORE INSERT ON TREE "
  36         "FOR EACH ROW BEGIN "
  37         "SELECT RAISE(ROLLBACK, "
  38                       "'insert on table \"TREE\" violates "
  39                       "foreign key constraint \"fki_TREE_NODE_NODE_ID_id\"') "
  40         "WHERE (SELECT ID FROM NODE WHERE ID = NEW.NODE) IS NULL; END;"
  41     } concat
  42 } [
  43     {
  44         { "table-name" "TREE" }
  45         { "table-id" "NODE" }
  46         { "foreign-table-name" "NODE" }
  47         { "foreign-table-id" "ID" }
  48     } [ insert-trigger ] with-variables normalize
  49 ] unit-test
  50
  51 : db-path ( -- path ) "test-" cell number>string ".db" 3append temp-file ;
  52 : test.db ( -- sqlite-db ) db-path <sqlite-db> ;
  53
  54 db-path ?delete-file
  55
  56 { } [
  57     test.db [
  58         "create table person (name varchar(30), country varchar(30))" sql-command
  59         "insert into person values('John', 'America')" sql-command
  60         "insert into person values('Jane', 'New Zealand')" sql-command
  61     ] with-db
  62 ] unit-test
  63
  64
  65 { { { "John" "America" } { "Jane" "New Zealand" } } } [
  66     test.db [
  67         "select * from person" sql-query
  68     ] with-db
  69 ] unit-test
  70
  71 { { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } }
  72 [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
  73
  74 { } [
  75     test.db [
  76         "insert into person(name, country) values('Jimmy', 'Canada')"
  77         sql-command
  78     ] with-db
  79 ] unit-test
  80
  81 {
  82     {
  83         { "1" "John" "America" }
  84         { "2" "Jane" "New Zealand" }
  85         { "3" "Jimmy" "Canada" }
  86     }
  87 } [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
  88
  89 [
  90     test.db [
  91         [
  92             "insert into person(name, country) values('Jose', 'Mexico')" sql-command
  93             "insert into person(name, country) values('Jose', 'Mexico')" sql-command
  94             "oops" throw
  95         ] with-transaction
  96     ] with-db
  97 ] must-fail
  98
  99 { 3 } [
 100     test.db [
 101         "select * from person" sql-query length
 102     ] with-db
 103 ] unit-test
 104
 105 { } [
 106     test.db [
 107         [
 108             "insert into person(name, country) values('Jose', 'Mexico')"
 109             sql-command
 110             "insert into person(name, country) values('Jose', 'Mexico')"
 111             sql-command
 112         ] with-transaction
 113     ] with-db
 114 ] unit-test
 115
 116 { 5 } [
 117     test.db [
 118         "select * from person" sql-query length
 119     ] with-db
 120 ] unit-test
 121
 122 [ \ swap ensure-table ] must-fail
 123
 124 ! You don't need a primary key
 125 TUPLE: things one two ;
 126
 127 things "THINGS" {
 128     { "one" "ONE" INTEGER +not-null+ }
 129     { "two" "TWO" INTEGER +not-null+ }
 130 } define-persistent
 131
 132 { { { 0 0 } { 0 1 } { 1 0 } { 1 1 } } } [
 133     test.db [
 134        things create-table
 135         0 0 things boa insert-tuple
 136         0 1 things boa insert-tuple
 137         1 1 things boa insert-tuple
 138         1 0 things boa insert-tuple
 139         f f things boa select-tuples
 140         [ [ one>> ] [ two>> ] bi 2array ] map natural-sort
 141        things drop-table
 142     ] with-db
 143 ] unit-test
 144
 145 ! Tables can have different names than the name of the tuple
 146 TUPLE: foo slot ;
 147 C: <foo> foo
 148 foo "BAR" { { "slot" "SOMETHING" INTEGER +not-null+ } } define-persistent
 149
 150 TUPLE: hi bye try ;
 151 C: <hi> hi
 152 hi "HELLO" {
 153     { "bye" "BUHBYE" INTEGER { +foreign-id+ foo "SOMETHING" } }
 154     { "try" "RETHROW" INTEGER { +foreign-id+ foo "SOMETHING" } }
 155 } define-persistent
 156
 157 { T{ foo { slot 1 } } T{ hi { bye 1 } { try 1 } } } [
 158     test.db [
 159         foo create-table
 160         hi create-table
 161         1 <foo> insert-tuple
 162         f <foo> select-tuple
 163         1 1 <hi> insert-tuple
 164         f f <hi> select-tuple
 165         hi drop-table
 166         foo drop-table
 167     ] with-db
 168 ] unit-test
 169
 170
 171 ! Test SQLite triggers
 172
 173 TUPLE: show id ;
 174 TUPLE: user username data ;
 175 TUPLE: watch show user ;
 176
 177 user "USER" {
 178     { "username" "USERNAME" TEXT +not-null+ +user-assigned-id+ }
 179     { "data" "DATA" TEXT }
 180 } define-persistent
 181
 182 show "SHOW" {
 183     { "id" "ID" +db-assigned-id+ }
 184 } define-persistent
 185
 186 watch "WATCH" {
 187     { "user" "USER" TEXT +not-null+ +user-assigned-id+
 188         { +foreign-id+ user "USERNAME" } }
 189     { "show" "SHOW" BIG-INTEGER +not-null+ +user-assigned-id+
 190         { +foreign-id+ show "ID" } }
 191 } define-persistent
 192
 193 { T{ user { username "littledan" } { data "foo" } } } [
 194     test.db [
 195         user create-table
 196         show create-table
 197         watch create-table
 198         "littledan" "foo" user boa insert-tuple
 199         "mark" "bar" user boa insert-tuple
 200         show new insert-tuple
 201         show new select-tuple
 202         "littledan" f user boa select-tuple
 203         [ id>> ] [ username>> ] bi*
 204         watch boa insert-tuple
 205         watch new select-tuple
 206         user>> f user boa select-tuple
 207         user new "mark" >>username delete-tuples
 208     ] with-db
 209 ] unit-test
 210
 211 { } [
 212     test.db [ [
 213             user ensure-table [
 214                 "mew" "foo" user boa insert-tuple
 215                 "denny" "kitty" user boa insert-tuple
 216             ] with-transaction
 217         ] with-transaction
 218     ] with-db
 219 ] unit-test
 220
 221 ! Reported by AlexIljin
 222 { f } [
 223     TUPLE: num-test1 num ;
 224     num-test1 "NUM_TEST" { { "num" "NUM" INTEGER } } define-persistent
 225     test.db [
 226         num-test1 ensure-table
 227         num-test1 new insert-tuple
 228         num-test1 new select-tuple
 229     ] with-db num>>
 230 ] unit-test
 231
 232 { f } [
 233     TUPLE: num-test2 num ;
 234     num-test2 "NUM_TEST" { { "num" "NUM" DOUBLE } } define-persistent
 235     test.db [
 236         num-test2 ensure-table
 237         num-test2 new insert-tuple
 238         num-test2 new select-tuple
 239     ] with-db num>>
 240 ] unit-test
 241
 242 { f } [
 243     TUPLE: num-test3 num ;
 244     num-test3 "NUM_TEST" { { "num" "NUM" BOOLEAN } } define-persistent
 245     test.db [
 246         num-test3 ensure-table
 247         num-test3 new insert-tuple
 248         num-test3 new select-tuple
 249     ] with-db num>>
 250 ] unit-test
 251
 252 [
 253     TUPLE: no-table name ;
 254     no-table "NO_TABLE" { { "name" "NAME" VARCHAR } } define-persistent
 255     test.db [ no-table new select-tuple ] with-db
 256 ] [ sql-table-missing? ] must-fail-with