factor: trim using lists

[factor.git] / basis / db / tester / tester.factor

diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor
index 4e53ad3df782ff3c72d2de4469cd4b99795319f3..0029a0de1e27b52d7238af0fc6c08e831cfdb40b 100644 (file)
--- a/basis/db/tester/tester.factor
+++ b/basis/db/tester/tester.factor
@@ -1,10 +1,50 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: concurrency.combinators db.pools db.sqlite db.tuples
-db.types kernel math random threads tools.test db sequences
-io prettyprint ;
+USING: accessors assocs concurrency.combinators db db.pools
+db.postgresql db.queries db.sqlite db.tuples db.types
+destructors io.files.temp kernel math math.parser namespaces
+random sequences system threads tools.test ;
 IN: db.tester
 
+: postgresql-test-db-name ( -- string )
+    cpu name>> "-" "factor-test" 3append
+    H{ { CHAR: - CHAR: _ } { CHAR: . CHAR: _ } } substitute ;
+
+: postgresql-test-db ( -- postgresql-db )
+    \ postgresql-db get-global clone postgresql-test-db-name >>database ;
+
+: postgresql-template1-db ( -- postgresql-db )
+    \ postgresql-db get-global clone "template1" >>database ;
+
+: sqlite-test-db ( -- sqlite-db )
+    cpu name>> "tuples-test." ".db" surround
+    temp-file <sqlite-db> ;
+
+! These words leak resources, but are useful for interactive testing
+: set-sqlite-db ( -- )
+    sqlite-db db-open db-connection set ;
+
+: set-postgresql-db ( -- )
+    postgresql-db db-open db-connection set ;
+
+
+: test-sqlite ( quot -- )
+    '[
+        [ ] [ sqlite-test-db _ with-db ] unit-test
+    ] call ; inline
+
+: test-postgresql ( quot -- )
+
+    '[
+        os windows? cpu x86.64? and [
+            postgresql-template1-db [
+                postgresql-test-db-name ensure-database
+            ] with-db
+            [ ] [ postgresql-test-db _ with-db ] unit-test
+        ] unless
+    ] call ; inline
+
+
 TUPLE: test-1 id a b c ;
 
 test-1 "TEST1" {
@@ -23,8 +63,9 @@ test-2 "TEST2" {
    { "z" "Z" { VARCHAR 256 } +not-null+ }
 } define-persistent
 
-: sqlite-test-db ( -- db ) "test.db" <sqlite-db> ;
-: test-db ( -- db ) "test.db" <sqlite-db> ;
+: test-1-tuple ( -- tuple )
+    f 100 random 100 random 100 random [ number>string ] tri@
+    test-1 boa ;
 
 : db-tester ( test-db -- )
     [
@@ -33,12 +74,11 @@ test-2 "TEST2" {
             test-2 ensure-table
         ] with-db
     ] [
-        10 [
+        10 <iota> [
             drop
             10 [
                 dup [
-                    f 100 random 100 random 100 random test-1 boa
-                    insert-tuple yield
+                    test-1-tuple insert-tuple yield
                 ] with-db
             ] times
         ] with parallel-each
@@ -46,12 +86,18 @@ test-2 "TEST2" {
 
 : db-tester2 ( test-db -- )
     [
-        [ test-1 recreate-table ] with-db
-    ] [
         [
-            2 [
-                    10 random 100 random 100 random 100 random test-1 boa
-                    insert-tuple yield
-            ] parallel-each
+            test-1 ensure-table
+            test-2 ensure-table
         ] with-db
+    ] [
+        <db-pool> [
+            [
+                10 <iota> [
+                    10 [
+                        test-1-tuple insert-tuple yield
+                    ] times
+                ] parallel-each
+            ] with-pooled-db
+        ] with-disposal
     ] bi ;