forestdb.lib: fdb_doc has to be malloc'd. Iterators have to fdb_doc_free docs. Add with-doc and with-create-doc combinators. Unit testing fdb-get etc.
parent
9348cb48ef
commit
2f2cd7b299
|
@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.data alien.strings arrays
|
||||||
assocs combinators continuations destructors forestdb.ffi fry
|
assocs combinators continuations destructors forestdb.ffi fry
|
||||||
io.directories io.files.temp io.pathnames kernel libc make
|
io.directories io.files.temp io.pathnames kernel libc make
|
||||||
math.parser math.ranges multiline namespaces sequences
|
math.parser math.ranges multiline namespaces sequences
|
||||||
tools.test ;
|
tools.test classes.struct ;
|
||||||
IN: forestdb.lib
|
IN: forestdb.lib
|
||||||
|
|
||||||
: test-db-0 ( -- path ) "0.forestdb.0" temp-file ;
|
: test-db-0 ( -- path ) "0.forestdb.0" temp-file ;
|
||||||
|
@ -52,6 +52,59 @@ IN: forestdb.lib
|
||||||
] with-forestdb-path
|
] with-forestdb-path
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! Get
|
||||||
|
{
|
||||||
|
{ "key1" "val" }
|
||||||
|
} [
|
||||||
|
delete-test-db-1 test-db-1 [
|
||||||
|
5 set-kv-n
|
||||||
|
fdb-commit-normal
|
||||||
|
"key1" "meta" "val" [
|
||||||
|
fdb_doc>doc [ key>> ] [ body>> ] bi 2array
|
||||||
|
] with-create-doc
|
||||||
|
] with-forestdb-path
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{
|
||||||
|
{ "key1" f "val1" }
|
||||||
|
} [
|
||||||
|
delete-test-db-1 test-db-1 [
|
||||||
|
5 set-kv-n
|
||||||
|
fdb-commit-normal
|
||||||
|
"key1" "no meta" "going away" [
|
||||||
|
fdb-get
|
||||||
|
fdb_doc>doc [ key>> ] [ meta>> ] [ body>> ] tri 3array
|
||||||
|
] with-create-doc
|
||||||
|
] with-forestdb-path
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
{ "key2" f "val2" }
|
||||||
|
} [
|
||||||
|
delete-test-db-1 test-db-1 [
|
||||||
|
5 set-kv-n
|
||||||
|
fdb-commit-normal
|
||||||
|
2 <seqnum-doc> [
|
||||||
|
fdb-get-byseq fdb_doc>doc
|
||||||
|
[ key>> ] [ meta>> ] [ body>> ] tri 3array
|
||||||
|
] with-doc
|
||||||
|
] with-forestdb-path
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{
|
||||||
|
{ "key2" f "val2" }
|
||||||
|
} [
|
||||||
|
delete-test-db-1 test-db-1 [
|
||||||
|
5 set-kv-n
|
||||||
|
fdb-commit-normal
|
||||||
|
2 <seqnum-doc> [
|
||||||
|
fdb-get-byseq fdb_doc>doc
|
||||||
|
[ key>> ] [ meta>> ] [ body>> ] tri 3array
|
||||||
|
] with-doc
|
||||||
|
] with-forestdb-path
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
! Filename is only valid inside with-forestdb
|
! Filename is only valid inside with-forestdb
|
||||||
{ f } [
|
{ f } [
|
||||||
|
@ -65,17 +118,19 @@ IN: forestdb.lib
|
||||||
{ 6 9 9 } [
|
{ 6 9 9 } [
|
||||||
delete-test-db-0
|
delete-test-db-0
|
||||||
test-db-0 [
|
test-db-0 [
|
||||||
"key123" "meta blah" "some body" fdb-doc-create
|
"key123" "meta blah" "some body" [
|
||||||
[ keylen>> ] [ metalen>> ] [ bodylen>> ] tri
|
[ keylen>> ] [ metalen>> ] [ bodylen>> ] tri
|
||||||
|
] with-create-doc
|
||||||
] with-forestdb-path
|
] with-forestdb-path
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ 7 8 15 } [
|
{ 7 8 15 } [
|
||||||
delete-test-db-0
|
delete-test-db-0
|
||||||
test-db-0 [
|
test-db-0 [
|
||||||
"key1234" "meta blah" "some body" fdb-doc-create
|
"key1234" "meta blah" "some body" [
|
||||||
dup "new meta" "some other body" fdb-doc-update
|
[ "new meta" "some other body" fdb-doc-update ]
|
||||||
[ keylen>> ] [ metalen>> ] [ bodylen>> ] tri
|
[ [ keylen>> ] [ metalen>> ] [ bodylen>> ] tri ] bi
|
||||||
|
] with-create-doc
|
||||||
] with-forestdb-path
|
] with-forestdb-path
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
|
@ -14,6 +14,8 @@ IN: forestdb.lib
|
||||||
! 3) build on macosx doesn't include -L/usr/local/lib when it finds snappy
|
! 3) build on macosx doesn't include -L/usr/local/lib when it finds snappy
|
||||||
! - link_directories(/usr/local/lib) or some other fix
|
! - link_directories(/usr/local/lib) or some other fix
|
||||||
! 4) byseq iteration doesn't have bodies, weird.
|
! 4) byseq iteration doesn't have bodies, weird.
|
||||||
|
! 5) Get byseq ignores seqnum and uses key instead if key is set
|
||||||
|
|
||||||
*/
|
*/
|
||||||
|
|
||||||
ERROR: fdb-error error ;
|
ERROR: fdb-error error ;
|
||||||
|
@ -59,6 +61,14 @@ SYMBOL: fdb-current
|
||||||
[ get-handle ] 2dip
|
[ get-handle ] 2dip
|
||||||
[ dup length ] bi@ fdb_set_kv fdb-check-error ;
|
[ dup length ] bi@ fdb_set_kv fdb-check-error ;
|
||||||
|
|
||||||
|
: <key-doc> ( key -- doc )
|
||||||
|
fdb_doc malloc-struct
|
||||||
|
swap [ utf8 malloc-string >>key ] [ length >>keylen ] bi ;
|
||||||
|
|
||||||
|
: <seqnum-doc> ( seqnum -- doc )
|
||||||
|
fdb_doc malloc-struct
|
||||||
|
swap >>seqnum ;
|
||||||
|
|
||||||
! Fill in document by exemplar
|
! Fill in document by exemplar
|
||||||
: fdb-get ( doc -- doc )
|
: fdb-get ( doc -- doc )
|
||||||
[ get-handle ] dip [ fdb_get fdb-check-error ] keep ;
|
[ get-handle ] dip [ fdb_get fdb-check-error ] keep ;
|
||||||
|
@ -110,6 +120,17 @@ SYMBOL: fdb-current
|
||||||
: fdb-doc-free ( doc -- )
|
: fdb-doc-free ( doc -- )
|
||||||
fdb_doc_free fdb-check-error ;
|
fdb_doc_free fdb-check-error ;
|
||||||
|
|
||||||
|
: clear-doc-key ( doc -- doc )
|
||||||
|
[ dup [ (free) f ] when ] change-key
|
||||||
|
0 >>keylen ;
|
||||||
|
|
||||||
|
: with-doc ( doc quot: ( doc -- ) -- )
|
||||||
|
over '[ _ _ [ _ fdb-doc-free rethrow ] recover ] call ; inline
|
||||||
|
|
||||||
|
: with-create-doc ( key meta body quot: ( doc -- ) -- )
|
||||||
|
[ fdb-doc-create ] dip with-doc ; inline
|
||||||
|
|
||||||
|
|
||||||
: fdb-info ( -- info )
|
: fdb-info ( -- info )
|
||||||
get-handle
|
get-handle
|
||||||
fdb_info <struct> [ fdb_get_dbinfo fdb-check-error ] keep ;
|
fdb_info <struct> [ fdb_get_dbinfo fdb-check-error ] keep ;
|
||||||
|
@ -183,7 +204,7 @@ M: fdb-iterator dispose*
|
||||||
|
|
||||||
: fdb-iterate ( iterator word -- doc )
|
: fdb-iterate ( iterator word -- doc )
|
||||||
'[
|
'[
|
||||||
fdb_doc <struct> fdb_doc <ref>
|
fdb_doc malloc-struct fdb_doc <ref>
|
||||||
[ _ execute ] keep swap check-iterate-result
|
[ _ execute ] keep swap check-iterate-result
|
||||||
] call ; inline
|
] call ; inline
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue