From 4fd4882e024aabf424272208881ab170424d33b2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 5 Mar 2008 13:51:31 -0600 Subject: [PATCH] fix unit tests --- extra/db/postgresql/postgresql-tests.factor | 259 -------------------- extra/db/sqlite/sqlite-tests.factor | 194 +-------------- 2 files changed, 12 insertions(+), 441 deletions(-) diff --git a/extra/db/postgresql/postgresql-tests.factor b/extra/db/postgresql/postgresql-tests.factor index 250f98f73e..a6c2975c89 100755 --- a/extra/db/postgresql/postgresql-tests.factor +++ b/extra/db/postgresql/postgresql-tests.factor @@ -33,24 +33,6 @@ IN: db.postgresql.tests ] with-db ] unit-test -[ - { { "John" "America" } } -] [ - test-db [ - "select * from person where name = $1 and country = $2" - f f [ - { { "Jane" TEXT } { "New Zealand" TEXT } } - over do-bound-query - - { { "Jane" "New Zealand" } } = - [ "test fails" throw ] unless - - { { "John" TEXT } { "America" TEXT } } - swap do-bound-query - ] with-disposal - ] with-db -] unit-test - [ { { "John" "America" } @@ -111,244 +93,3 @@ IN: db.postgresql.tests : with-dummy-db ( quot -- ) >r T{ postgresql-db } db r> with-variable ; - -! TEST TUPLE DB - -TUPLE: puppy id name age ; -: ( name age -- puppy ) - { set-puppy-name set-puppy-age } puppy construct ; - -puppy "PUPPY" { - { "id" "ID" +native-id+ +not-null+ } - { "name" "NAME" { VARCHAR 256 } } - { "age" "AGE" INTEGER } -} define-persistent - -TUPLE: kitty id name age ; -: ( name age -- kitty ) - { set-kitty-name set-kitty-age } kitty construct ; - -kitty "KITTY" { - { "id" "ID" INTEGER +assigned-id+ } - { "name" "NAME" TEXT } - { "age" "AGE" INTEGER } -} define-persistent - -TUPLE: basket id puppies kitties ; -basket "BASKET" -{ - { "id" "ID" +native-id+ +not-null+ } - { "location" "LOCATION" TEXT } - { "puppies" { +has-many+ puppy } } - { "kitties" { +has-many+ kitty } } -} define-persistent - -! Create table -[ - "create table puppy(id serial primary key not null, name varchar 256, age integer);" -] [ - T{ postgresql-db } db [ - puppy dup db-columns swap db-table create-table-sql >lower - ] with-variable -] unit-test - -[ - "create table kitty(id integer primary key, name text, age integer);" -] [ - T{ postgresql-db } db [ - kitty dup db-columns swap db-table create-table-sql >lower - ] with-variable -] unit-test - -[ - "create table basket(id serial primary key not null, location text);" -] [ - T{ postgresql-db } db [ - basket dup db-columns swap db-table create-table-sql >lower - ] with-variable -] unit-test - -! Create function -[ - "create function add_puppy(varchar,integer) returns bigint as 'insert into puppy(name, age) values($1, $2); select currval(''puppy_id_seq'');' language sql;" -] [ - T{ postgresql-db } db [ - puppy dup db-columns swap db-table create-function-sql >lower - ] with-variable -] unit-test - -! Drop table - -[ - "drop table puppy;" -] [ - T{ postgresql-db } db [ - puppy db-table drop-table-sql >lower - ] with-variable -] unit-test - -[ - "drop table kitty;" -] [ - T{ postgresql-db } db [ - kitty db-table drop-table-sql >lower - ] with-variable -] unit-test - -[ - "drop table basket;" -] [ - T{ postgresql-db } db [ - basket db-table drop-table-sql >lower - ] with-variable -] unit-test - - -! Drop function -[ - "drop function add_puppy(varchar, integer);" -] [ - T{ postgresql-db } db [ - puppy dup db-columns swap db-table drop-function-sql >lower - ] with-variable -] unit-test - -! Insert -[ -] [ - T{ postgresql-db } db [ - puppy - ] with-variable -] unit-test - -[ - "insert into kitty(id, name, age) values($1, $2, $3);" - { - T{ - sql-spec - f - "id" - "ID" - INTEGER - { +assigned-id+ } - +assigned-id+ - } - T{ sql-spec f "name" "NAME" TEXT { } f } - T{ sql-spec f "age" "AGE" INTEGER { } f } - } - { } -] [ - T{ postgresql-db } db [ - kitty - ] with-variable -] unit-test - -! Update -[ - "update puppy set name = $1, age = $2 where id = $3" - { - T{ sql-spec f "name" "NAME" { VARCHAR 256 } { } f } - T{ sql-spec f "age" "AGE" INTEGER { } f } - T{ - sql-spec - f - "id" - "ID" - +native-id+ - { +not-null+ } - +native-id+ - } - } - { } -] [ - T{ postgresql-db } db [ - puppy dup db-columns swap db-table >r >r >lower r> r> - ] with-variable -] unit-test - -[ - "update kitty set name = $1, age = $2 where id = $3" - { - T{ sql-spec f "name" "NAME" TEXT { } f } - T{ sql-spec f "age" "AGE" INTEGER { } f } - T{ - sql-spec - f - "id" - "ID" - INTEGER - { +assigned-id+ } - +assigned-id+ - } - } - { } -] [ - T{ postgresql-db } db [ - kitty dup db-columns swap db-table >r >r >lower r> r> - ] with-variable -] unit-test - -! Delete -[ - "delete from puppy where id = $1" - { - T{ - sql-spec - f - "id" - "ID" - +native-id+ - { +not-null+ } - +native-id+ - } - } - { } -] [ - T{ postgresql-db } db [ - puppy dup db-columns swap db-table >r >r >lower r> r> - ] with-variable -] unit-test - -[ - "delete from KITTY where ID = $1" - { - T{ - sql-spec - f - "id" - "ID" - INTEGER - { +assigned-id+ } - +assigned-id+ - } - } - { } -] [ - T{ postgresql-db } db [ - kitty dup db-columns swap db-table - ] with-variable -] unit-test - -! Select -[ - "select from PUPPY ID, NAME, AGE where NAME = $1;" - { T{ sql-spec f "name" "NAME" { VARCHAR 256 } { } f } } - { - T{ - sql-spec - f - "id" - "ID" - +native-id+ - { +not-null+ } - +native-id+ - } - T{ sql-spec f "name" "NAME" { VARCHAR 256 } { } f } - T{ sql-spec f "age" "AGE" INTEGER { } f } - } -] [ - T{ postgresql-db } db [ - T{ puppy f f "Mr. Clunkers" } - - ] with-variable -] unit-test diff --git a/extra/db/sqlite/sqlite-tests.factor b/extra/db/sqlite/sqlite-tests.factor index 974fdb8782..08139610a0 100755 --- a/extra/db/sqlite/sqlite-tests.factor +++ b/extra/db/sqlite/sqlite-tests.factor @@ -3,49 +3,34 @@ prettyprint tools.test db.sqlite db sequences continuations db.types db.tuples unicode.case ; IN: db.sqlite.tests -: test.db "extra/db/sqlite/test.db" resource-path ; +: db-path "extra/db/sqlite/test.db" resource-path ; +: test.db db-path sqlite-db ; -[ ] [ [ test.db delete-file ] ignore-errors ] unit-test +[ ] [ [ db-path delete-file ] ignore-errors ] unit-test [ ] [ test.db [ "create table person (name varchar(30), country varchar(30))" sql-command "insert into person values('John', 'America')" sql-command "insert into person values('Jane', 'New Zealand')" sql-command - ] with-sqlite + ] with-db ] unit-test [ { { "John" "America" } { "Jane" "New Zealand" } } ] [ test.db [ "select * from person" sql-query - ] with-sqlite -] unit-test - -[ { { "John" "America" } } ] [ - test.db [ - "select * from person where name = :name and country = :country" - [ - { { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } } - over do-bound-query - - { { "Jane" "New Zealand" } } = - [ "test fails" throw ] unless - - { { ":name" "John" TEXT } { ":country" "America" TEXT } } - swap do-bound-query - ] with-disposal - ] with-sqlite + ] with-db ] unit-test [ { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } ] -[ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test +[ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test [ ] [ test.db [ "insert into person(name, country) values('Jimmy', 'Canada')" sql-command - ] with-sqlite + ] with-db ] unit-test [ @@ -54,7 +39,7 @@ IN: db.sqlite.tests { "2" "Jane" "New Zealand" } { "3" "Jimmy" "Canada" } } -] [ test.db [ "select rowid, * from person" sql-query ] with-sqlite ] unit-test +] [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test [ test.db [ @@ -63,13 +48,13 @@ IN: db.sqlite.tests "insert into person(name, country) values('Jose', 'Mexico')" sql-command "oops" throw ] with-transaction - ] with-sqlite + ] with-db ] must-fail [ 3 ] [ test.db [ "select * from person" sql-query length - ] with-sqlite + ] with-db ] unit-test [ @@ -81,166 +66,11 @@ IN: db.sqlite.tests "insert into person(name, country) values('Jose', 'Mexico')" sql-command ] with-transaction - ] with-sqlite + ] with-db ] unit-test [ 5 ] [ test.db [ "select * from person" sql-query length - ] with-sqlite -] unit-test - -! TEST TUPLE DB - -TUPLE: puppy id name age ; -: ( name age -- puppy ) - { set-puppy-name set-puppy-age } puppy construct ; - -puppy "PUPPY" { - { "id" "ID" +native-id+ +not-null+ } - { "name" "NAME" { VARCHAR 256 } } - { "age" "AGE" INTEGER } -} define-persistent - -TUPLE: kitty id name age ; -: ( name age -- kitty ) - { set-kitty-name set-kitty-age } kitty construct ; - -kitty "KITTY" { - { "id" "ID" INTEGER +assigned-id+ } - { "name" "NAME" TEXT } - { "age" "AGE" INTEGER } -} define-persistent - -TUPLE: basket id puppies kitties ; -basket "BASKET" -{ - { "id" "ID" +native-id+ +not-null+ } - { "location" "LOCATION" TEXT } - { "puppies" { +has-many+ puppy } } - { "kitties" { +has-many+ kitty } } -} define-persistent - -! Create table -[ - "create table puppy(id integer primary key not null, name varchar, age integer);" -] [ - T{ sqlite-db } db [ - puppy dup db-columns swap db-table create-sql >lower - ] with-variable -] unit-test - -[ - "create table kitty(id integer primary key, name text, age integer);" -] [ - T{ sqlite-db } db [ - kitty dup db-columns swap db-table create-sql >lower - ] with-variable -] unit-test - -[ - "create table basket(id integer primary key not null, location text);" -] [ - T{ sqlite-db } db [ - basket dup db-columns swap db-table create-sql >lower - ] with-variable -] unit-test - -! Drop table -[ - "drop table puppy;" -] [ - T{ sqlite-db } db [ - puppy db-table drop-sql >lower - ] with-variable -] unit-test - -[ - "drop table kitty;" -] [ - T{ sqlite-db } db [ - kitty db-table drop-sql >lower - ] with-variable -] unit-test - -[ - "drop table basket;" -] [ - T{ sqlite-db } db [ - basket db-table drop-sql >lower - ] with-variable -] unit-test - -! Insert -[ - "insert into puppy(name, age) values(:name, :age);" -] [ - T{ sqlite-db } db [ - puppy dup db-columns swap db-table insert-sql* >lower - ] with-variable -] unit-test - -[ - "insert into kitty(id, name, age) values(:id, :name, :age);" -] [ - T{ sqlite-db } db [ - kitty dup db-columns swap db-table insert-sql* >lower - ] with-variable -] unit-test - -! Update -[ - "update puppy set name = :name, age = :age where id = :id" -] [ - T{ sqlite-db } db [ - puppy dup db-columns swap db-table update-sql* >lower - ] with-variable -] unit-test - -[ - "update kitty set name = :name, age = :age where id = :id" -] [ - T{ sqlite-db } db [ - kitty dup db-columns swap db-table update-sql* >lower - ] with-variable -] unit-test - -! Delete -[ - "delete from puppy where id = :id" -] [ - T{ sqlite-db } db [ - puppy dup db-columns swap db-table delete-sql* >lower - ] with-variable -] unit-test - -[ - "delete from kitty where id = :id" -] [ - T{ sqlite-db } db [ - kitty dup db-columns swap db-table delete-sql* >lower - ] with-variable -] unit-test - -! Select -[ - "select from puppy id, name, age where name = :name;" - { - T{ - sql-spec - f - "id" - "ID" - +native-id+ - { +not-null+ } - +native-id+ - } - T{ sql-spec f "name" "NAME" { VARCHAR 256 } { } f } - T{ sql-spec f "age" "AGE" INTEGER { } f } - } -] [ - T{ sqlite-db } db [ - T{ puppy f f "Mr. Clunkers" } - select-sql >r >lower r> - ] with-variable + ] with-db ] unit-test