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: concurrency.combinators db.pools db.sqlite db.tuples
   4 db.types kernel math random threads tools.test db sequences
   5 io prettyprint db.postgresql accessors io.files.temp
   6 namespaces fry system math.parser db.queries assocs ;
   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>
  15         "localhost" >>host
  16         "postgres" >>username
  17         "thepasswordistrust" >>password
  18         postgresql-test-db-name >>database ;
  19
  20 : postgresql-template1-db ( -- postgresql-db )
  21     <postgresql-db>
  22         "localhost" >>host
  23         "postgres" >>username
  24         "thepasswordistrust" >>password
  25         "template1" >>database ;
  26
  27 : sqlite-test-db ( -- sqlite-db )
  28     "tuples-test.db" temp-file <sqlite-db> ;
  29
  30 ! These words leak resources, but are useful for interactivel testing
  31 : set-sqlite-db ( -- )
  32     sqlite-db db-open db-connection set ;
  33
  34 : set-postgresql-db ( -- )
  35     postgresql-db db-open db-connection set ;
  36
  37
  38 : test-sqlite ( quot -- )
  39     '[
  40         [ ] [ sqlite-test-db _ with-db ] unit-test
  41     ] call ; inline
  42
  43 : test-postgresql ( quot -- )
  44     postgresql-template1-db [
  45         postgresql-test-db-name ensure-database
  46     ] with-db
  47
  48     '[
  49         os windows? cpu x86.64? and [
  50             [ ] [ postgresql-test-db _ with-db ] unit-test
  51         ] unless
  52     ] call ; inline
  53
  54
  55 TUPLE: test-1 id a b c ;
  56
  57 test-1 "TEST1" {
  58    { "id" "ID" INTEGER +db-assigned-id+ }
  59    { "a" "A" { VARCHAR 256 } +not-null+ }
  60    { "b" "B" { VARCHAR 256 } +not-null+ }
  61    { "c" "C" { VARCHAR 256 } +not-null+ }
  62 } define-persistent
  63
  64 TUPLE: test-2 id x y z ;
  65
  66 test-2 "TEST2" {
  67    { "id" "ID" INTEGER +db-assigned-id+ }
  68    { "x" "X" { VARCHAR 256 } +not-null+ }
  69    { "y" "Y" { VARCHAR 256 } +not-null+ }
  70    { "z" "Z" { VARCHAR 256 } +not-null+ }
  71 } define-persistent
  72
  73 : test-1-tuple ( -- tuple )
  74     f 100 random 100 random 100 random [ number>string ] tri@
  75     test-1 boa ;
  76
  77 : db-tester ( test-db -- )
  78     [
  79         [
  80             test-1 ensure-table
  81             test-2 ensure-table
  82         ] with-db
  83     ] [
  84         10 iota [
  85             drop
  86             10 [
  87                 dup [
  88                     test-1-tuple insert-tuple yield
  89                 ] with-db
  90             ] times
  91         ] with parallel-each
  92     ] bi ;
  93
  94 : db-tester2 ( test-db -- )
  95     [
  96         [
  97             test-1 ensure-table
  98             test-2 ensure-table
  99         ] with-db
 100     ] [
 101         <db-pool> [
 102             10 iota [
 103                 10 [
 104                     test-1-tuple insert-tuple yield
 105                 ] times
 106             ] parallel-each
 107         ] with-pooled-db
 108     ] bi ;