From 7ce7df5f89e543f775ab35f8c013936b8a4faa21 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Sat, 8 Mar 2008 10:07:11 +1100 Subject: [PATCH] latest semantic-db --- extra/semantic-db/hierarchy/hierarchy.factor | 2 +- extra/semantic-db/semantic-db-tests.factor | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/semantic-db/hierarchy/hierarchy.factor b/extra/semantic-db/hierarchy/hierarchy.factor index ef7670d15c..fa10fff01c 100644 --- a/extra/semantic-db/hierarchy/hierarchy.factor +++ b/extra/semantic-db/hierarchy/hierarchy.factor @@ -16,7 +16,7 @@ C: tree parent-child* drop ; : un-parent-child ( parent child -- ) - has-parent-relation -rot select-tuples [ id>> delete-arc ] each ; + has-parent-relation spin select-tuples [ id>> delete-arc ] each ; : child-arcs ( node-id -- child-arcs ) has-parent-relation f rot select-tuples ; diff --git a/extra/semantic-db/semantic-db-tests.factor b/extra/semantic-db/semantic-db-tests.factor index 4f67895a6f..01476a145a 100644 --- a/extra/semantic-db/semantic-db-tests.factor +++ b/extra/semantic-db/semantic-db-tests.factor @@ -1,7 +1,7 @@ USING: accessors arrays db db.sqlite db.tuples kernel math namespaces semantic-db semantic-db.context semantic-db.hierarchy semantic-db.relations sequences tools.test tools.walker ; -IN: vocab.tests +IN: semantic-db.tests [ create-node-table create-arc-table @@ -48,11 +48,11 @@ IN: vocab.tests "charlie" create-node* "charlie" set "gertrude" create-node* "gertrude" set [ t ] [ "adam" get "bob" get parent-child* integer? ] unit-test - { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each + { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each [ { "bob" "fran" } ] [ "eve" get children [ 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 - [ { "adam" "eve" } ] [ "charlie" get get-root-nodes ] unit-test - [ { } ] [ "fran" get "charlie" get tuck un-parent-child parents ] unit-test + [ { "adam" "eve" } ] [ "charlie" get break get-root-nodes [ node-content ] map ] unit-test + [ { } ] [ "fran" get "charlie" get tuck un-parent-child parents [ node-content ] map ] unit-test ] with-context ] with-tmp-sqlite