Merge branch 'master' of git://factorcode.org/git/factor

[factor.git] / basis / db / tuples / tuples-tests.factor

diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor
old mode 100755 (executable)
new mode 100644 (file)
index 7e3aa44..f5569a9
--- a/basis/db/tuples/tuples-tests.factor
+++ b/basis/db/tuples/tuples-tests.factor
@@ -7,16 +7,34 @@ db.postgresql accessors random math.bitwise
 math.ranges strings urls fry db.tuples.private ;
 IN: db.tuples.tests
 
+: sqlite-db ( -- sqlite-db )
+    "tuples-test.db" temp-file <sqlite-db> ;
+
 : test-sqlite ( quot -- )
-    [ ] swap '[
-        "tuples-test.db" temp-file sqlite-db _ with-db
-    ] unit-test ;
+    '[
+        [ ] [
+            "tuples-test.db" temp-file <sqlite-db> _ with-db
+        ] unit-test
+    ] call ; inline
+
+: postgresql-db ( -- postgresql-db )
+    <postgresql-db>
+        "localhost" >>host
+        "postgres" >>username
+        "thepasswordistrust" >>password
+        "factor-test" >>database ;
 
 : test-postgresql ( quot -- )
-    [ ] swap '[
-        { "localhost" "postgres" "foob" "factor-test" }
-        postgresql-db _ with-db
-    ] unit-test ;
+    '[
+        [ ] [ postgresql-db _ with-db ] unit-test
+    ] call ; inline
+
+! These words leak resources, but are useful for interactivel testing 
+: sqlite-test-db ( -- )
+    sqlite-db db-open db set ;
+
+: postgresql-test-db ( -- )
+    postgresql-db db-open db set ;
 
 TUPLE: person the-id the-name the-number the-real
 ts date time blob factor-blob url ;
@@ -176,26 +194,61 @@ SYMBOL: person4
         T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } }
         f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" <user-assigned-person> person4 set ;
 
+
 TUPLE: paste n summary author channel mode contents timestamp annotations ;
 TUPLE: annotation n paste-id summary author mode contents ;
 
-: db-assigned-paste-schema ( -- )
-    paste "PASTE"
+paste "PASTE"
+{
+    { "n" "ID" +db-assigned-id+ }
+    { "summary" "SUMMARY" TEXT }
+    { "author" "AUTHOR" TEXT }
+    { "channel" "CHANNEL" TEXT }
+    { "mode" "MODE" TEXT }
+    { "contents" "CONTENTS" TEXT }
+    { "timestamp" "DATE" TIMESTAMP }
+    { "annotations" { +has-many+ annotation } }
+} define-persistent
+
+: annotation-schema-foreign-key ( -- )
+    annotation "ANNOTATION"
+    {
+        { "n" "ID" +db-assigned-id+ }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } }
+        { "summary" "SUMMARY" TEXT }
+        { "author" "AUTHOR" TEXT }
+        { "mode" "MODE" TEXT }
+        { "contents" "CONTENTS" TEXT }
+    } define-persistent ;
+
+: annotation-schema-foreign-key-not-null ( -- )
+    annotation "ANNOTATION"
     {
         { "n" "ID" +db-assigned-id+ }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } +not-null+ }
         { "summary" "SUMMARY" TEXT }
         { "author" "AUTHOR" TEXT }
-        { "channel" "CHANNEL" TEXT }
         { "mode" "MODE" TEXT }
         { "contents" "CONTENTS" TEXT }
-        { "timestamp" "DATE" TIMESTAMP }
-        { "annotations" { +has-many+ annotation } }
-    } define-persistent
+    } define-persistent ;
+
+: annotation-schema-cascade ( -- )
+    annotation "ANNOTATION"
+    {
+        { "n" "ID" +db-assigned-id+ }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" }
+            +on-delete+ +cascade+ }
+        { "summary" "SUMMARY" TEXT }
+        { "author" "AUTHOR" TEXT }
+        { "mode" "MODE" TEXT }
+        { "contents" "CONTENTS" TEXT }
+    } define-persistent ;
 
+: annotation-schema-restrict ( -- )
     annotation "ANNOTATION"
     {
         { "n" "ID" +db-assigned-id+ }
-        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+        { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } }
         { "summary" "SUMMARY" TEXT }
         { "author" "AUTHOR" TEXT }
         { "mode" "MODE" TEXT }
@@ -203,7 +256,6 @@ TUPLE: annotation n paste-id summary author mode contents ;
     } define-persistent ;
 
 : test-paste-schema ( -- )
-    [ ] [ db-assigned-paste-schema ] unit-test
     [ ] [ paste ensure-table ] unit-test
     [ ] [ annotation ensure-table ] unit-test
     [ ] [ annotation drop-table ] unit-test
@@ -228,14 +280,38 @@ TUPLE: annotation n paste-id summary author mode contents ;
             "erg" >>author
             "annotation contents" >>contents
         insert-tuple
-    ] unit-test
-
-    [ ] [
-    ] unit-test
-    ;
+    ] unit-test ;
 
-[ test-paste-schema ] test-sqlite
-[ test-paste-schema ] test-postgresql
+: test-foreign-key ( -- )
+    [ ] [ annotation-schema-foreign-key ] unit-test
+    test-paste-schema
+    [ paste new 1 >>n delete-tuples ] must-fail ;
+
+: test-foreign-key-not-null ( -- )
+    [ ] [ annotation-schema-foreign-key-not-null ] unit-test
+    test-paste-schema
+    [ paste new 1 >>n delete-tuples ] must-fail ;
+
+: test-cascade ( -- )
+    [ ] [ annotation-schema-cascade ] unit-test
+    test-paste-schema
+    [ ] [ paste new 1 >>n delete-tuples ] unit-test
+    [ 0 ] [ paste new select-tuples length ] unit-test ;
+
+: test-restrict ( -- )
+    [ ] [ annotation-schema-restrict ] unit-test
+    test-paste-schema
+    [ paste new 1 >>n delete-tuples ] must-fail ;
+
+[ test-foreign-key ] test-sqlite
+[ test-foreign-key-not-null ] test-sqlite
+[ test-cascade ] test-sqlite
+[ test-restrict ] test-sqlite
+
+[ test-foreign-key ] test-postgresql
+[ test-foreign-key-not-null ] test-postgresql
+[ test-cascade ] test-postgresql
+[ test-restrict ] test-postgresql
 
 : test-repeated-insert
     [ ] [ person ensure-table ] unit-test
@@ -292,6 +368,14 @@ TUPLE: exam id name score ;
     [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
     [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
 
+    [ 4 ]
+    [ T{ exam { name IGNORE } { score IGNORE } } select-tuples length ] unit-test
+
+    [ f ]
+    [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test
+
+    [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with
+
     [
         {
             T{ exam f 3 "Kenny" 60 }
@@ -573,10 +657,3 @@ compound-foo "COMPOUND_FOO"
 
 [ test-compound-primary-key ] test-sqlite
 [ test-compound-primary-key ] test-postgresql
-
-: test-sqlite-db ( -- )
-    "tuples-test.db" temp-file sqlite-db make-db db-open db set ;
-
-: test-postgresql-db ( -- )
-    { "localhost" "postgres" "foob" "factor-test" } postgresql-db
-    make-db db-open db set ;