basis/db/tester/tester.factor

   1 ! Copyright (C) 2008 Slava Pestov, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs concurrency.combinators db db.pools
   4 db.postgresql db.queries db.sqlite db.tuples db.types
   5 destructors io.files.temp kernel math math.parser namespaces
   6 random sequences system threads tools.test ;
   7 IN: db.tester
   8
   9 : postgresql-test-db-name ( -- string )
  10     cpu name>> "-" "factor-test" 3append
  11     H{ { CHAR: - CHAR: _ } { CHAR: . CHAR: _ } } substitute ;
  12
  13 : postgresql-test-db ( -- postgresql-db )
  14     \ postgresql-db get-global clone postgresql-test-db-name >>database ;
  15
  16 : postgresql-template1-db ( -- postgresql-db )
  17     \ postgresql-db get-global clone "template1" >>database ;
  18
  19 : sqlite-test-db ( -- sqlite-db )
  20     cpu name>> "tuples-test." ".db" surround
  21     temp-file <sqlite-db> ;
  22
  23 ! These words leak resources, but are useful for interactive testing
  24 : set-sqlite-db ( -- )
  25     sqlite-db db-open db-connection set ;
  26
  27 : set-postgresql-db ( -- )
  28     postgresql-db db-open db-connection set ;
  29
  30
  31 : test-sqlite ( quot -- )
  32     '[
  33         [ ] [ sqlite-test-db _ with-db ] unit-test
  34     ] call ; inline
  35
  36 : test-postgresql ( quot -- )
  37
  38     '[
  39         os windows? cpu x86.64? and [
  40             postgresql-template1-db [
  41                 postgresql-test-db-name ensure-database
  42             ] with-db
  43             [ ] [ postgresql-test-db _ with-db ] unit-test
  44         ] unless
  45     ] call ; inline
  46
  47
  48 TUPLE: test-1 id a b c ;
  49
  50 test-1 "TEST1" {
  51    { "id" "ID" INTEGER +db-assigned-id+ }
  52    { "a" "A" { VARCHAR 256 } +not-null+ }
  53    { "b" "B" { VARCHAR 256 } +not-null+ }
  54    { "c" "C" { VARCHAR 256 } +not-null+ }
  55 } define-persistent
  56
  57 TUPLE: test-2 id x y z ;
  58
  59 test-2 "TEST2" {
  60    { "id" "ID" INTEGER +db-assigned-id+ }
  61    { "x" "X" { VARCHAR 256 } +not-null+ }
  62    { "y" "Y" { VARCHAR 256 } +not-null+ }
  63    { "z" "Z" { VARCHAR 256 } +not-null+ }
  64 } define-persistent
  65
  66 : test-1-tuple ( -- tuple )
  67     f 100 random 100 random 100 random [ number>string ] tri@
  68     test-1 boa ;
  69
  70 : db-tester ( test-db -- )
  71     [
  72         [
  73             test-1 ensure-table
  74             test-2 ensure-table
  75         ] with-db
  76     ] [
  77         10 <iota> [
  78             drop
  79             10 [
  80                 dup [
  81                     test-1-tuple insert-tuple yield
  82                 ] with-db
  83             ] times
  84         ] with parallel-each
  85     ] bi ;
  86
  87 : db-tester2 ( test-db -- )
  88     [
  89         [
  90             test-1 ensure-table
  91             test-2 ensure-table
  92         ] with-db
  93     ] [
  94         <db-pool> [
  95             [
  96                 10 <iota> [
  97                     10 [
  98                         test-1-tuple insert-tuple yield
  99                     ] times
 100                 ] parallel-each
 101             ] with-pooled-db
 102         ] with-disposal
 103     ] bi ;