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

View File

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

View File

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

View File

@ -142,7 +142,8 @@ HOOK: bind% db ( spec -- )
HOOK: bind# db ( spec obj -- )
: 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 )
tuck offset-of-slot slot ;