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

semantic-db: fix a unit test and USE a missing vocab

db4
Alex Chapman 2008-03-13 15:41:51 +11:00
parent 14f4a282d6
commit 88c0ca84ef
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/semantic-db/hierarchy/hierarchy.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors db.tuples hashtables kernel new-slots USING: accessors db.tuples hashtables kernel new-slots
semantic-db semantic-db.relations sorting sequences ; semantic-db semantic-db.relations sequences sequences.deep ;
IN: semantic-db.hierarchy IN: semantic-db.hierarchy
TUPLE: tree id children ; TUPLE: tree id children ;

9
extra/semantic-db/semantic-db-tests.factor
View File

@ -1,6 +1,7 @@
USING: accessors arrays continuations db db.sqlite db.tuples io.files USING: accessors arrays continuations db db.sqlite
kernel math namespaces semantic-db semantic-db.context db.tuples io.files kernel math namespaces semantic-db
semantic-db.hierarchy semantic-db.relations sequences tools.test semantic-db.context semantic-db.hierarchy
semantic-db.relations sequences sorting tools.test
tools.walker ; tools.walker ;
IN: semantic-db.tests IN: semantic-db.tests
@ -63,7 +64,7 @@ test-db [
[ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test [ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test
[ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test [ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test
[ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test [ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test
[ { "adam" "eve" } ] [ "charlie" get get-root-nodes [ node-content ] map ] unit-test [ { "adam" "eve" } ] [ "charlie" get get-root-nodes [ node-content ] map natural-sort >array ] unit-test
[ { } ] [ "fran" get "charlie" get tuck un-parent-child parents [ node-content ] map ] unit-test [ { } ] [ "fran" get "charlie" get tuck un-parent-child parents [ node-content ] map ] unit-test
] with-context ] with-context
] with-db ] with-db