references with cascade on delete work

diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor
index 430109f22907faa31ff77d864687e05242b2ceea..28548d1260efe456c23820552e89fa9fe1c05d44 100755 (executable)
--- a/basis/db/postgresql/postgresql.factor
+++ b/basis/db/postgresql/postgresql.factor
@@ -231,6 +231,8 @@ M: postgresql-db persistent-table ( -- hashtable )
         { +user-assigned-id+ { f f f } }
         { +random-id+ { "bigint" "bigint" f } }
 
+        { +foreign-id+ { f f "references" } }
+
         { +on-delete+ { f f "on delete" } }
         { +restrict+ { f f "restrict" } }
         { +cascade+ { f f "cascade" } }
@@ -251,7 +253,6 @@ M: postgresql-db persistent-table ( -- hashtable )
         { BLOB { "bytea" "bytea" f } }
         { FACTOR-BLOB { "bytea" "bytea" f } }
         { URL { "varchar" "varchar" f } }
-        { +foreign-id+ { f f "references" } }
         { +autoincrement+ { f f "autoincrement" } }
         { +unique+ { f f "unique" } }
         { +default+ { f f "default" } }
@@ -267,10 +268,6 @@ M: postgresql-db compound ( string object -- string' )
     over {
         { "default" [ first number>string join-space ] }
         { "varchar" [ first number>string paren append ] }
-        { "references" [
-                first2 >r [ unparse join-space ] keep db-columns r>
-                swap [ slot-name>> = ] with find nip
-                column-name>> paren append
-            ] }
+        { "references" [ >reference-string ] }
         [ drop no-compound-found ]
     } case ;

diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index 60eeb61965ed50f5fc3f30ff5d09f7407f19e214..e2a4b994e3d94b67faeb7340e51f3d08ba111d84 100755 (executable)
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@ -171,7 +171,7 @@ M: sqlite-db persistent-table ( -- assoc )
         { +db-assigned-id+ { "integer" "integer" f } }
         { +user-assigned-id+ { f f f } }
         { +random-id+ { "integer" "integer" f } }
-        { +foreign-id+ { "integer" "integer" f } }
+        { +foreign-id+ { "integer" "integer" "references" } }
 
         { +on-delete+ { f f "on delete" } }
         { +restrict+ { f f "restrict" } }
@@ -203,8 +203,9 @@ M: sqlite-db persistent-table ( -- assoc )
         { random-generator { f f f } }
     } ;
 
-M: sqlite-db compound ( str seq -- str' )
+M: sqlite-db compound ( string seq -- new-string )
     over {
         { "default" [ first number>string join-space ] }
-        [ 2drop ] 
+        { "references" [ >reference-string ] }
+        [ 2dup . . 2drop ] 
     } case ;

diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
index 7e3aa44c403f358365e3f20b516209fce22799c2..6a5e78aa4b9552391f86d9908200f7cf671170e0 100755 (executable)
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -195,7 +195,8 @@ TUPLE: annotation n paste-id summary author mode contents ;
     annotation "ANNOTATION"
     {
         { "n" "ID" +db-assigned-id+ }
-        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" }
+            +on-delete+ +cascade+ }
         { "summary" "SUMMARY" TEXT }
         { "author" "AUTHOR" TEXT }
         { "mode" "MODE" TEXT }
@@ -574,9 +575,9 @@ compound-foo "COMPOUND_FOO"
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
 
-: test-sqlite-db ( -- )
+: sqlite-test-db ( -- )
     "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
 
-: test-postgresql-db ( -- )
+: postgresql-test-db ( -- )
     { "localhost" "postgres" "foob" "factor-test" } postgresql-db
     make-db db-open db set ;

diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor
index 8e2a794cc26a4c5c5e960606e1fcb4614bfa9937..43feed69c82ddc9e997d4acebe91481311a94260 100755 (executable)
--- a/basis/db/types/types.factor
+++ b/basis/db/types/types.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
-sequences continuations sequences.deep
+sequences continuations sequences.deep prettyprint
 words namespaces slots slots.private classes mirrors
 classes.tuple combinators calendar.format symbols
 classes.singleton accessors quotations random ;
@@ -158,3 +158,9 @@ ERROR: no-sql-type type ;
 
 HOOK: bind% db ( spec -- )
 HOOK: bind# db ( spec obj -- )
+
+: >reference-string ( string pair -- string )
+    first2
+    [ [ unparse join-space ] [ db-columns ] bi ] dip
+    swap [ slot-name>> = ] with find nip
+    column-name>> paren append ;