still working on db2

extra/db2/connections/connections-tests.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db2.connections db2.tester ;
+IN: db2.connections.tests
+
+! Tests connection
+
+{ 1 0 } [ [ ] with-db ] must-infer-as

extra/db2/connections/connections.factor

@@ -10,9 +10,7 @@ TUPLE: db-connection handle ;
         swap >>handle ; inline
 
 GENERIC: db-open ( db -- db-connection )
-
 GENERIC: db-close ( handle  -- )
-
 HOOK: parse-db-error db-connection ( error -- error' )
 
 M: db-connection dispose ( db-connection -- )

extra/db2/db2-tests.factor

@@ -0,0 +1,5 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db2 kernel ;
+IN: db2.tests
+

extra/db2/errors/errors.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel continuations fry words constructors ;
+USING: accessors kernel continuations fry words constructors
+db2.connections ;
 IN: db2.errors
 
 ERROR: db-error ;
 ERROR: sql-error location ;
+HOOK: parse-sql-error db-connection ( error -- error' )
 
 ERROR: sql-unknown-error < sql-error message ;
 CONSTRUCTOR: sql-unknown-error ( message -- error ) ;

extra/db2/errors/postgresql/postgresql-tests.factor

@@ -1,32 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit db db.errors
-db.errors.postgresql db.postgresql io.files.unique kernel namespaces
-tools.test db.tester continuations ;
-IN: db.errors.postgresql.tests
-
-[
-
-    [ "drop table foo;" sql-command ] ignore-errors
-    [ "drop table ship;" sql-command ] ignore-errors
-
-    [
-        "insert into foo (id) values('1');" sql-command
-    ] [
-        { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
-    ] must-fail-with
-
-    [
-        "create table ship(id integer);" sql-command
-        "create table ship(id integer);" sql-command
-    ] [
-        { [ sql-table-exists? ] [ table>> "ship" = ] } 1&&
-    ] must-fail-with
-    
-    [
-        "create table foo(id) lol;" sql-command
-    ] [
-        sql-syntax-error?
-    ] must-fail-with
-
-] test-postgresql

extra/db2/errors/postgresql/postgresql.factor

@@ -1,53 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel db.errors peg.ebnf strings sequences math
-combinators.short-circuit accessors math.parser quoting ;
-IN: db.errors.postgresql
-
-EBNF: parse-postgresql-sql-error
-
-Error = "ERROR:" [ ]+
-
-TableError =
-    Error ("relation "|"table ")(!(" already exists").)+:table " already exists"
-        => [[ table >string unquote <sql-table-exists> ]]
-    | Error ("relation "|"table ")(!(" does not exist").)+:table " does not exist"
-        => [[ table >string unquote <sql-table-missing> ]]
-
-FunctionError =
-    Error "function" (!(" already exists").)+:table " already exists"
-        => [[ table >string <sql-function-exists> ]]
-    | Error "function" (!(" does not exist").)+:table " does not exist"
-        => [[ table >string <sql-function-missing> ]]
-
-SyntaxError =
-    Error "syntax error at end of input":error
-        => [[ error >string <sql-syntax-error> ]]
-    | Error "syntax error at or near " .+:syntaxerror
-        => [[ syntaxerror >string unquote <sql-syntax-error> ]]
-
-UnknownError = .* => [[ >string <sql-unknown-error> ]]
-
-PostgresqlSqlError = (TableError | FunctionError | SyntaxError | UnknownError) 
-
-;EBNF
-
-
-ERROR: parse-postgresql-location column line text ;
-C: <parse-postgresql-location> parse-postgresql-location
-
-EBNF: parse-postgresql-line-error
-
-Line = "LINE " [0-9]+:line ": " .+:sql
-    => [[ f line >string string>number sql >string <parse-postgresql-location> ]] 
-
-;EBNF
-
-:: set-caret-position ( error caret-line -- error )
-    caret-line length
-    error line>> number>string length "LINE : " length +
-    - [ error ] dip >>column ;
-
-: postgresql-location ( line column -- obj )
-    [ parse-postgresql-line-error ] dip
-    set-caret-position ;

extra/db2/errors/sqlite/sqlite-tests.factor

@@ -1,26 +0,0 @@
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit db db.errors
-db.errors.sqlite db.sqlite io.files.unique kernel namespaces
-tools.test ;
-IN: db.errors.sqlite.tests
-
-: sqlite-error-test-db-path ( -- path )
-    "sqlite" "error-test" make-unique-file ;
-
-sqlite-error-test-db-path <sqlite-db> [
-
-    [
-        "insert into foo (id) values('1');" sql-command
-    ] [
-        { [ sql-table-missing? ] [ table>> "foo" = ] } 1&&
-    ] must-fail-with
-    
-    [
-        "create table foo(id);" sql-command
-        "create table foo(id);" sql-command
-    ] [
-        { [ sql-table-exists? ] [ table>> "foo" = ] } 1&&
-    ] must-fail-with
-
-] with-db

extra/db2/sqlite/connections/connections-tests.factor

@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db2.sqlite.connections ;
+IN: db2.sqlite.connections.tests

extra/db2/sqlite/connections/connections.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators db2.connections db2.sqlite
+db2.sqlite.errors db2.sqlite.lib kernel ;
+IN: db2.sqlite.connections
+
+TUPLE: sqlite-db-connection < db-connection ;
+
+: <sqlite-db-connection> ( handle -- db-connection )
+    sqlite-db-connection new-db-connection ;
+
+M: sqlite-db db-open ( db -- db-connection )
+    path>> sqlite-open <sqlite-db-connection> ;
+
+M: sqlite-db-connection db-close ( db-connection -- )
+    handle>> sqlite-close ;
+
+M: sqlite-db-connection parse-db-error ( error -- error' )
+    dup n>> {
+        { 1 [ string>> parse-sqlite-sql-error ] }
+        [ drop ]
+    } case ;

extra/db2/sqlite/db/db.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors ;
+IN: db2.sqlite.db
+
+TUPLE: sqlite-db path ;
+
+: <sqlite-db> ( path -- sqlite-db )
+    sqlite-db new
+        swap >>path ;
+
+

extra/db2/sqlite/errors/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/sqlite/errors/errors.factor

@@ -1,22 +1,31 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators db kernel sequences peg.ebnf
+USING: accessors combinators db2.connections db2.errors
-strings db.errors ;
+db2.sqlite.ffi kernel locals namespaces peg.ebnf sequences
-IN: db.errors.sqlite
+strings ;
+IN: db2.sqlite.errors
+
+ERROR: sqlite-error < db-error n string ;
+ERROR: sqlite-sql-error < sql-error n string ;
+
+: throw-sqlite-error ( n -- * )
+    dup sqlite-error-messages nth sqlite-error ;
+
+: sqlite-statement-error ( -- * )
+    SQLITE_ERROR
+    db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
 
 TUPLE: unparsed-sqlite-error error ;
 C: <unparsed-sqlite-error> unparsed-sqlite-error
 
-SINGLETONS: table-exists table-missing ;
-
 : sqlite-table-error ( table message -- error )
     {
-        { table-exists [ <sql-table-exists> ] }
+        { sql-table-exists [ <sql-table-exists> ] }
     } case ;
 
 EBNF: parse-sqlite-sql-error
 
-TableMessage = " already exists" => [[ table-exists ]]
+TableMessage = " already exists" => [[ sql-table-exists ]]
 
 SqliteError =
     "table " (!(TableMessage).)+:table TableMessage:message

extra/db2/sqlite/lib/lib.factor

@@ -3,20 +3,11 @@
 USING: accessors alien.c-types arrays calendar.format
 combinators db2.connections db2.sqlite.ffi db2.errors
 io.backend io.encodings.string io.encodings.utf8 kernel math
-namespaces present sequences serialize urls ;
+namespaces present sequences serialize urls db2.sqlite.errors ;
 IN: db2.sqlite.lib
 
 : ?when ( object quot -- object' ) dupd when ; inline
 
-ERROR: sqlite-error < db-error n string ;
-ERROR: sqlite-sql-error < sql-error n string ;
-
-: throw-sqlite-error ( n -- * )
-    dup sqlite-error-messages nth sqlite-error ;
-
-: sqlite-statement-error ( -- * )
-    SQLITE_ERROR
-    db-connection get handle>> sqlite3_errmsg sqlite-sql-error ;
 
 : sqlite-check-result ( n -- )
     {

extra/db2/sqlite/result-sets/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/sqlite/result-sets/result-sets.factor

@@ -0,0 +1,7 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: db2.result-sets ;
+IN: db2.sqlite.result-sets
+
+TUPLE: sqlite-result-set < result-set has-more? ;
+

extra/db2/sqlite/statements/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/db2/sqlite/statements/statements.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: db2.connections db2.statements db2.sqlite.connections
+db2.sqlite.lib ;
+IN: db2.sqlite.statements
+
+TUPLE: sqlite-statement < statement ;
+
+M: sqlite-db-connection <statement> ( string in out -- obj )
+    sqlite-statement new-statement ;
+

extra/db2/statements/statements-tests.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db2.statements kernel ;
+IN: db2.statements.tests
+
+{ 1 0 } [ [ drop ] statement-each ] must-infer-as
+{ 1 1 } [ [ ] statement-map ] must-infer-as
+
+[ ]
+[
+    "insert into computer (name, os) values('rocky', 'mac');"
+    
+] unit-test

extra/db2/tester/authors.txt

@@ -0,0 +1,2 @@
+Slava Pestov
+Doug Coleman

extra/db2/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 db2.tester ;
+IN: db2.tester.tests
+
+! [ ] [ sqlite-test-db db-tester ] unit-test
+! [ ] [ sqlite-test-db db-tester2 ] unit-test

extra/db2/tester/tester.factor

@@ -0,0 +1,96 @@
+! Copyright (C) 2008 Slava Pestov, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: concurrency.combinators db2.connections
+db2.pools db2.sqlite db2.types fry io.files.temp kernel math
+namespaces random threads tools.test combinators ;
+IN: db2.tester
+USE: multiline
+
+: sqlite-test-db ( -- sqlite-db )
+    "tuples-test.db" temp-file <sqlite-db> ;
+
+! These words leak resources, but are useful for interactivel testing
+: set-sqlite-db ( -- )
+    sqlite-db db-open db-connection set ;
+
+: test-sqlite ( quot -- )
+    '[
+        [ ] [ sqlite-test-db _ with-db ] unit-test
+    ] call ; inline
+
+: test-dbs ( quot -- )
+    {
+        [ test-sqlite ]
+    } cleave ;
+
+/*
+: postgresql-test-db ( -- postgresql-db )
+    <postgresql-db>
+        "localhost" >>host
+        "postgres" >>username
+        "thepasswordistrust" >>password
+        "factor-test" >>database ;
+
+: set-postgresql-db ( -- )
+    postgresql-db db-open db-connection set ;
+
+: test-postgresql ( quot -- )
+    '[
+        os windows? cpu x86.64? and [
+            [ ] [ postgresql-test-db _ with-db ] unit-test
+        ] unless
+    ] call ; inline
+
+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
+
+: 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 ensure-table
+            test-2 ensure-table
+        ] 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
+    ] bi ;
+*/