steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add some failing unit tests

db4
Slava Pestov 2008-05-30 16:13:47 -05:00
parent 4f61a531ce
commit cc662c94ed
3 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/db/tuples/tuples-tests.factor
View File

@ -198,9 +198,10 @@ TUPLE: annotation n paste-id summary author mode contents ;
: test-sqlite ( quot -- ) : test-sqlite ( quot -- )
>r "tuples-test.db" temp-file sqlite-db r> with-db ; >r "tuples-test.db" temp-file sqlite-db r> with-db ;
: test-postgresql ( -- ) ! : test-postgresql ( quot -- )
>r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ; ! >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
: test-postgresql drop ;
: test-repeated-insert : test-repeated-insert
[ ] [ person ensure-table ] unit-test [ ] [ person ensure-table ] unit-test
[ ] [ person1 get insert-tuple ] unit-test [ ] [ person1 get insert-tuple ] unit-test
@ -415,7 +416,7 @@ TUPLE: does-not-persist ;
] test-postgresql ] test-postgresql
TUPLE: suparclass a ; TUPLE: suparclass id a ;
suparclass f { suparclass f {
{ "id" "ID" +db-assigned-id+ } { "id" "ID" +db-assigned-id+ }
@ -429,7 +430,16 @@ subbclass "SUBCLASS" {
} define-persistent } define-persistent
: test-db-inheritance ( -- ) : test-db-inheritance ( -- )
[ ] [ subbclass ensure-table ] unit-test ; [ ] [ subbclass ensure-table ] unit-test
[ ] [
subbclass new 5 >>a "hi" >>b dup insert-tuple id>> "id" set
] unit-test
[ t "hi" 5 ] [
subbclass new "id" get >>id select-tuple
[ subbclass? ] [ b>> ] [ a>> ] tri
] unit-test ;
[ test-db-inheritance ] test-sqlite [ test-db-inheritance ] test-sqlite

4
extra/db/tuples/tuples.factor
View File

@ -13,10 +13,10 @@ IN: db.tuples
"db-columns" set-word-prop "db-columns" set-word-prop
"db-relations" set-word-prop ; "db-relations" set-word-prop ;
ERROR: not-persistent ; ERROR: not-persistent class ;
: db-table ( class -- obj ) : db-table ( class -- obj )
"db-table" word-prop [ not-persistent ] unless* ; dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
: db-columns ( class -- obj ) : db-columns ( class -- obj )
superclasses [ "db-columns" word-prop ] map concat ; superclasses [ "db-columns" word-prop ] map concat ;

3
extra/db/types/types.factor
View File

@ -142,7 +142,8 @@ HOOK: bind% db ( spec -- )
HOOK: bind# db ( spec obj -- ) HOOK: bind# db ( spec obj -- )
: offset-of-slot ( str obj -- n ) : offset-of-slot ( str obj -- n )
class "slots" word-prop slot-named slot-spec-offset ; class superclasses [ "slots" word-prop ] map concat
slot-named slot-spec-offset ;
: get-slot-named ( name obj -- value ) : get-slot-named ( name obj -- value )
tuck offset-of-slot slot ; tuck offset-of-slot slot ;