From 0a9677c0af560b283334b7bdc77134a113a72131 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 8 Jan 2009 16:41:38 -0600
Subject: [PATCH] Test the database with parallel combinators

---
 basis/db/tester/authors.txt         |  2 +
 basis/db/tester/tester-tests.factor |  7 ++++
 basis/db/tester/tester.factor       | 57 +++++++++++++++++++++++++++++
 3 files changed, 66 insertions(+)
 create mode 100644 basis/db/tester/authors.txt
 create mode 100644 basis/db/tester/tester-tests.factor
 create mode 100644 basis/db/tester/tester.factor

diff --git a/basis/db/tester/authors.txt b/basis/db/tester/authors.txt
new file mode 100644
index 0000000000..f372b574ae
--- /dev/null
+++ b/basis/db/tester/authors.txt
@@ -0,0 +1,2 @@
+Slava Pestov
+Doug Coleman
diff --git a/basis/db/tester/tester-tests.factor b/basis/db/tester/tester-tests.factor
new file mode 100644
index 0000000000..6b39a7e218
--- /dev/null
+++ b/basis/db/tester/tester-tests.factor
@@ -0,0 +1,7 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db.tester ;
+IN: db.tester.tests
+
+[ ] [ sqlite-test-db db-tester ] unit-test
+[ ] [ sqlite-test-db db-tester2 ] unit-test
diff --git a/basis/db/tester/tester.factor b/basis/db/tester/tester.factor
new file mode 100644
index 0000000000..4e53ad3df7
--- /dev/null
+++ b/basis/db/tester/tester.factor
@@ -0,0 +1,57 @@
+! 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 ;
+IN: db.tester
+
+TUPLE: test-1 id a b c ;
+
+test-1 "TEST1" {
+   { "id" "ID" INTEGER +db-assigned-id+ }
+   { "a" "A" { VARCHAR 256 } +not-null+ }
+   { "b" "B" { VARCHAR 256 } +not-null+ }
+   { "c" "C" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+TUPLE: test-2 id x y z ;
+
+test-2 "TEST2" {
+   { "id" "ID" INTEGER +db-assigned-id+ }
+   { "x" "X" { VARCHAR 256 } +not-null+ }
+   { "y" "Y" { VARCHAR 256 } +not-null+ }
+   { "z" "Z" { VARCHAR 256 } +not-null+ }
+} define-persistent
+
+: sqlite-test-db ( -- db ) "test.db" <sqlite-db> ;
+: test-db ( -- db ) "test.db" <sqlite-db> ;
+
+: db-tester ( test-db -- )
+    [
+        [
+            test-1 ensure-table
+            test-2 ensure-table
+        ] with-db
+    ] [
+        10 [
+            drop
+            10 [
+                dup [
+                    f 100 random 100 random 100 random test-1 boa
+                    insert-tuple yield
+                ] with-db
+            ] times
+        ] with parallel-each
+    ] bi ;
+
+: 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
+        ] with-db
+    ] bi ;