--- /dev/null
+! 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
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 -- )
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test db2 kernel ;
+IN: db2.tests
+
! 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 ) ;
+++ /dev/null
-Doug Coleman
\ No newline at end of file
+++ /dev/null
-! 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
+++ /dev/null
-! 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 ;
+++ /dev/null
-Doug Coleman
\ No newline at end of file
+++ /dev/null
-! 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
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators db kernel sequences peg.ebnf
-strings db.errors ;
-IN: db.errors.sqlite
-
-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> ] }
- } case ;
-
-EBNF: parse-sqlite-sql-error
-
-TableMessage = " already exists" => [[ table-exists ]]
-
-SqliteError =
- "table " (!(TableMessage).)+:table TableMessage:message
- => [[ table >string message sqlite-table-error ]]
- | "no such table: " .+:table
- => [[ table >string <sql-table-missing> ]]
- | .*:error
- => [[ error >string <unparsed-sqlite-error> ]]
-;EBNF
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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
--- /dev/null
+! 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 ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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 ;
+
+
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators db2.connections db2.errors
+db2.sqlite.ffi kernel locals namespaces peg.ebnf sequences
+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
+
+: sqlite-table-error ( table message -- error )
+ {
+ { sql-table-exists [ <sql-table-exists> ] }
+ } case ;
+
+EBNF: parse-sqlite-sql-error
+
+TableMessage = " already exists" => [[ sql-table-exists ]]
+
+SqliteError =
+ "table " (!(TableMessage).)+:table TableMessage:message
+ => [[ table >string message sqlite-table-error ]]
+ | "no such table: " .+:table
+ => [[ table >string <sql-table-missing> ]]
+ | .*:error
+ => [[ error >string <unparsed-sqlite-error> ]]
+;EBNF
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 -- )
{
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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? ;
+
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! 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 ;
+
--- /dev/null
+! 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
--- /dev/null
+Slava Pestov
+Doug Coleman
--- /dev/null
+! 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
--- /dev/null
+! 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 ;
+*/
projects / factor.git / commitdiff