! 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 db.postgresql db.sqlite accessors io.files.temp
-namespaces fry system ;
+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>
- "localhost" >>host
- "postgres" >>username
- "thepasswordistrust" >>password
- "factor-test" >>database ;
+ \ postgresql-db get-global clone postgresql-test-db-name >>database ;
-: sqlite-test-db ( -- sqlite-db )
- "tuples-test.db" temp-file <sqlite-db> ;
+: 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 interactivel testing
+! These words leak resources, but are useful for interactive testing
: set-sqlite-db ( -- )
sqlite-db db-open db-connection set ;
] 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
{ "z" "Z" { VARCHAR 256 } +not-null+ }
} define-persistent
+: test-1-tuple ( -- tuple )
+ f 100 random 100 random 100 random [ number>string ] tri@
+ test-1 boa ;
+
: db-tester ( test-db -- )
[
[
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
] with-db
] [
<db-pool> [
- 10 [
- 10 [
- f 100 random 100 random 100 random test-1 boa
- insert-tuple yield
- ] times
- ] parallel-each
- ] with-pooled-db
+ [
+ 10 <iota> [
+ 10 [
+ test-1-tuple insert-tuple yield
+ ] times
+ ] parallel-each
+ ] with-pooled-db
+ ] with-disposal
] bi ;