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 ;
7 : normalize ( str -- str' )
8 " \n" split harvest join-words ;
10 ! delete-trigger-restrict
13 "CREATE TRIGGER fkd_TREE_NODE_NODE_ID_id "
14 "BEFORE DELETE ON NODE "
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;"
23 { "table-name" "TREE" }
25 { "foreign-table-name" "NODE" }
26 { "foreign-table-id" "ID" }
27 } [ delete-trigger-restrict ] with-variables
34 "CREATE TRIGGER fki_TREE_NODE_NODE_ID_id "
35 "BEFORE INSERT ON TREE "
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;"
44 { "table-name" "TREE" }
46 { "foreign-table-name" "NODE" }
47 { "foreign-table-id" "ID" }
48 } [ insert-trigger ] with-variables normalize
51 : db-path ( -- path ) "test-" cell number>string ".db" 3append temp-file ;
52 : test.db ( -- sqlite-db ) db-path <sqlite-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
65 { { { "John" "America" } { "Jane" "New Zealand" } } } [
67 "select * from person" sql-query
71 { { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } }
72 [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
76 "insert into person(name, country) values('Jimmy', 'Canada')"
83 { "1" "John" "America" }
84 { "2" "Jane" "New Zealand" }
85 { "3" "Jimmy" "Canada" }
87 } [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
92 "insert into person(name, country) values('Jose', 'Mexico')" sql-command
93 "insert into person(name, country) values('Jose', 'Mexico')" sql-command
101 "select * from person" sql-query length
108 "insert into person(name, country) values('Jose', 'Mexico')"
110 "insert into person(name, country) values('Jose', 'Mexico')"
118 "select * from person" sql-query length
122 [ \ swap ensure-table ] must-fail
124 ! You don't need a primary key
125 TUPLE: things one two ;
128 { "one" "ONE" INTEGER +not-null+ }
129 { "two" "TWO" INTEGER +not-null+ }
132 { { { 0 0 } { 0 1 } { 1 0 } { 1 1 } } } [
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
145 ! Tables can have different names than the name of the tuple
148 foo "BAR" { { "slot" "SOMETHING" INTEGER +not-null+ } } define-persistent
153 { "bye" "BUHBYE" INTEGER { +foreign-id+ foo "SOMETHING" } }
154 { "try" "RETHROW" INTEGER { +foreign-id+ foo "SOMETHING" } }
157 { T{ foo { slot 1 } } T{ hi { bye 1 } { try 1 } } } [
163 1 1 <hi> insert-tuple
164 f f <hi> select-tuple
171 ! Test SQLite triggers
174 TUPLE: user username data ;
175 TUPLE: watch show user ;
178 { "username" "USERNAME" TEXT +not-null+ +user-assigned-id+ }
179 { "data" "DATA" TEXT }
183 { "id" "ID" +db-assigned-id+ }
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" } }
193 { T{ user { username "littledan" } { data "foo" } } } [
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
214 "mew" "foo" user boa insert-tuple
215 "denny" "kitty" user boa insert-tuple
221 ! Reported by AlexIljin
223 TUPLE: num-test1 num ;
224 num-test1 "NUM_TEST" { { "num" "NUM" INTEGER } } define-persistent
226 num-test1 ensure-table
227 num-test1 new insert-tuple
228 num-test1 new select-tuple
233 TUPLE: num-test2 num ;
234 num-test2 "NUM_TEST" { { "num" "NUM" DOUBLE } } define-persistent
236 num-test2 ensure-table
237 num-test2 new insert-tuple
238 num-test2 new select-tuple
243 TUPLE: num-test3 num ;
244 num-test3 "NUM_TEST" { { "num" "NUM" BOOLEAN } } define-persistent
246 num-test3 ensure-table
247 num-test3 new insert-tuple
248 num-test3 new select-tuple
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