From 98060c4bc97c5cda5b927105e4df6476bb3fba86 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 13 Feb 2008 05:50:45 -0600 Subject: [PATCH 1/7] builder: run benchmarks --- extra/builder/builder.factor | 26 +++++++++++++++++++++----- extra/builder/test/test.factor | 7 +++++-- 2 files changed, 26 insertions(+), 7 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 3563a6112a..0c9b0a2aba 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -11,6 +11,8 @@ IN: builder : runtime ( quot -- time ) benchmark nip ; +: minutes>ms ( min -- ms ) 60 * 1000 * ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SYMBOL: builder-recipients @@ -97,6 +99,7 @@ VAR: stamp } } { +stdout+ "../boot-log" } { +stderr+ +stdout+ } + { +timeout+ ,[ 20 minutes>ms ] } } ; : builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ; @@ -145,10 +148,22 @@ SYMBOL: build-status ! bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail - bootstrap dup dispose process-stream-process wait-for-process zero? not - [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ] - when +! bootstrap +! dup dispose process-stream-process wait-for-process +! zero? not +! [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ] +! when + [ + bootstrap + dup dispose process-stream-process wait-for-process + zero? not + [ "bootstrap non-zero" throw ] + when + ] + [ "Bootstrap error" print "../boot-log" cat "bootstrap" throw ] + recover + [ builder-test try-process ] [ "Builder test error" print throw ] recover @@ -160,6 +175,9 @@ SYMBOL: build-status "Did not pass load-everything: " print "../load-everything-vocabs" cat "Did not pass test-all: " print "../test-all-vocabs" cat + "Benchmarks: " print + "../benchmarks" [ stdio get contents eval ] with-file-in . + ] with-file-out ; : build ( -- ) @@ -168,8 +186,6 @@ SYMBOL: build-status ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: minutes>ms ( min -- ms ) 60 * 1000 * ; - : updates-available? ( -- ? ) git-id git-pull run-process drop diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index f521af1b7c..c18395acc9 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -6,7 +6,7 @@ USING: kernel namespaces sequences assocs builder continuations prettyprint tools.browser tools.test - bootstrap.stage2 ; + bootstrap.stage2 benchmark ; IN: builder.test @@ -16,9 +16,12 @@ IN: builder.test : do-tests ( -- ) run-all-tests keys "../test-all-vocabs" [ . ] with-file-out ; +: do-benchmarks ( -- ) run-benchmarks "../benchmarks" [ . ] with-file-out ; + : do-all ( -- ) bootstrap-time get "../boot-time" [ . ] with-file-out [ do-load ] runtime "../load-time" [ . ] with-file-out - [ do-tests ] runtime "../test-time" [ . ] with-file-out ; + [ do-tests ] runtime "../test-time" [ . ] with-file-out + do-benchmarks ; MAIN: do-all \ No newline at end of file From 7f48a7b023ddcbbf009793769a993f89f917cf19 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Feb 2008 13:38:41 -0600 Subject: [PATCH 2/7] add support for curl --- misc/factor.sh | 90 +++++++++++++++++++++++++++++++++----------------- 1 file changed, 60 insertions(+), 30 deletions(-) diff --git a/misc/factor.sh b/misc/factor.sh index 5d7e7d0b94..600d5eec84 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -14,16 +14,36 @@ NO_UI= GIT_PROTOCOL=${GIT_PROTOCOL:="git"} GIT_URL=${GIT_URL:=$GIT_PROTOCOL"://factorcode.org/git/factor.git"} +test_program_installed() { + if ! [[ -n `type -p $1` ]] ; then + return 0; + fi + return 1; +} ensure_program_installed() { - echo -n "Checking for $1..." - result=`type -p $1` - if ! [[ -n $result ]] ; then - echo "not found!" - echo "Install $1 and try again." - exit 1 - fi - echo "found!" + installed=0; + for i in $* ; + do + echo -n "Checking for $i..." + test_program_installed $1 + if [[ $? -eq 0 ]]; then + echo -n "not " + else + installed=$(( $installed + 1 )) + fi + echo "found!" + done + if [[ $installed -eq 0 ]] ; then + echo -n "Install " + if [[ $# -eq 1 ]] ; then + echo -n $1 + else + echo -n "any of [ $* ]" + fi + echo " and try again." + exit 1 + fi } check_ret() { @@ -47,11 +67,20 @@ check_gcc_version() { echo "ok." } +set_downloader() { + test_program_installed wget + if [[ $? -ne 0 ]] ; then + DOWNLOAD=wget + else + DOWNLOAD="curl -O" + fi +} + check_installed_programs() { ensure_program_installed chmod ensure_program_installed uname ensure_program_installed git - ensure_program_installed wget + ensure_program_installed wget curl ensure_program_installed gcc ensure_program_installed make case $OS in @@ -238,32 +267,33 @@ delete_boot_images() { echo "Deleting old images..." rm $BOOT_IMAGE > /dev/null 2>&1 rm $BOOT_IMAGE.* > /dev/null 2>&1 - rm staging.*.image > /dev/null 2>&1 + rm staging.*.image > /dev/null 2>&1 } get_boot_image() { - wget http://factorcode.org/images/latest/$BOOT_IMAGE - check_ret wget + get_url http://factorcode.org/images/latest/$BOOT_IMAGE +} + +get_url() { + if [[ $DOWNLOAD -eq "" ]] ; then + set_downloader; + fi + echo "HI" + echo $DOWNLOAD $1 ; + $DOWNLOAD $1 + check_ret $DOWNLOAD } maybe_download_dlls() { if [[ $OS == winnt ]] ; then - wget http://factorcode.org/dlls/freetype6.dll - check_ret wget - wget http://factorcode.org/dlls/zlib1.dll - check_ret wget - wget http://factorcode.org/dlls/OpenAL32.dll - check_ret wget - wget http://factorcode.org/dlls/alut.dll - check_ret wget - wget http://factorcode.org/dlls/ogg.dll - check_ret wget - wget http://factorcode.org/dlls/theora.dll - check_ret wget - wget http://factorcode.org/dlls/vorbis.dll - check_ret wget - wget http://factorcode.org/dlls/sqlite3.dll - check_ret wget + get_url http://factorcode.org/dlls/freetype6.dll + get_url http://factorcode.org/dlls/zlib1.dll + get_url http://factorcode.org/dlls/OpenAL32.dll + get_url http://factorcode.org/dlls/alut.dll + get_url http://factorcode.org/dlls/ogg.dll + get_url http://factorcode.org/dlls/theora.dll + get_url http://factorcode.org/dlls/vorbis.dll + get_url http://factorcode.org/dlls/sqlite3.dll chmod 777 *.dll check_ret chmod fi @@ -321,7 +351,7 @@ install_libraries() { } usage() { - echo "usage: $0 install|install-x11|self-update|quick-update|update|bootstrap|wget-bootstrap" + echo "usage: $0 install|install-x11|self-update|quick-update|update|bootstrap|net-bootstrap" echo "If you are behind a firewall, invoke as:" echo "env GIT_PROTOCOL=http $0 " } @@ -333,6 +363,6 @@ case "$1" in quick-update) update; refresh_image ;; update) update; update_bootstrap ;; bootstrap) get_config_info; bootstrap ;; - wget-bootstrap) get_config_info; delete_boot_images; get_boot_image; bootstrap ;; + net-bootstrap) get_config_info; delete_boot_images; get_boot_image; bootstrap ;; *) usage ;; esac From df1c5b5abaa44377211246051ba2d6ae47cb19d9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Feb 2008 14:20:37 -0600 Subject: [PATCH 3/7] use the factorcode.org checksums when downloading boot images --- misc/factor.sh | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/misc/factor.sh b/misc/factor.sh index 600d5eec84..46e800a988 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -83,6 +83,8 @@ check_installed_programs() { ensure_program_installed wget curl ensure_program_installed gcc ensure_program_installed make + ensure_program_installed md5sum + ensure_program_installed cut case $OS in netbsd) ensure_program_installed gmake;; esac @@ -263,14 +265,28 @@ make_factor() { invoke_make NO_UI=$NO_UI $MAKE_TARGET -j5 } -delete_boot_images() { +update_boot_images() { echo "Deleting old images..." - rm $BOOT_IMAGE > /dev/null 2>&1 + rm checksums.txt* > /dev/null 2>&1 rm $BOOT_IMAGE.* > /dev/null 2>&1 rm staging.*.image > /dev/null 2>&1 + if [[ -f $BOOT_IMAGE ]] ; then + get_url http://factorcode.org/images/latest/checksums.txt + factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '`; + disk_md5=`md5sum $BOOT_IMAGE|cut -f1 -d' '`; + if [[ "$factorcode_md5" == "$disk_md5" ]] ; then + echo "Your disk boot image matches the one on factorcode.org." + else + rm $BOOT_IMAGE > /dev/null 2>&1 + get_boot_image; + fi + else + get_boot_image + fi } get_boot_image() { + echo "Downloading boot image $BOOT_IMAGE." get_url http://factorcode.org/images/latest/$BOOT_IMAGE } @@ -278,7 +294,6 @@ get_url() { if [[ $DOWNLOAD -eq "" ]] ; then set_downloader; fi - echo "HI" echo $DOWNLOAD $1 ; $DOWNLOAD $1 check_ret $DOWNLOAD @@ -329,8 +344,7 @@ update() { } update_bootstrap() { - delete_boot_images - get_boot_image + update_boot_images bootstrap } @@ -363,6 +377,6 @@ case "$1" in quick-update) update; refresh_image ;; update) update; update_bootstrap ;; bootstrap) get_config_info; bootstrap ;; - net-bootstrap) get_config_info; delete_boot_images; get_boot_image; bootstrap ;; + net-bootstrap) get_config_info; update_boot_images; bootstrap ;; *) usage ;; esac From 9f2c032b2ff05f0d4f28d1589672b260e80659f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Feb 2008 14:32:43 -0600 Subject: [PATCH 4/7] make md5 run on mac --- misc/factor.sh | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/misc/factor.sh b/misc/factor.sh index 46e800a988..44feb329fb 100755 --- a/misc/factor.sh +++ b/misc/factor.sh @@ -26,7 +26,7 @@ ensure_program_installed() { for i in $* ; do echo -n "Checking for $i..." - test_program_installed $1 + test_program_installed $i if [[ $? -eq 0 ]]; then echo -n "not " else @@ -76,6 +76,15 @@ set_downloader() { fi } +set_md5sum() { + test_program_installed md5sum + if [[ $? -ne 0 ]] ; then + MD5SUM=md5sum + else + MD5SUM="md5 -r" + fi +} + check_installed_programs() { ensure_program_installed chmod ensure_program_installed uname @@ -83,7 +92,7 @@ check_installed_programs() { ensure_program_installed wget curl ensure_program_installed gcc ensure_program_installed make - ensure_program_installed md5sum + ensure_program_installed md5sum md5 ensure_program_installed cut case $OS in netbsd) ensure_program_installed gmake;; @@ -273,7 +282,10 @@ update_boot_images() { if [[ -f $BOOT_IMAGE ]] ; then get_url http://factorcode.org/images/latest/checksums.txt factorcode_md5=`cat checksums.txt|grep $BOOT_IMAGE|cut -f2 -d' '`; - disk_md5=`md5sum $BOOT_IMAGE|cut -f1 -d' '`; + set_md5sum + disk_md5=`$MD5SUM $BOOT_IMAGE|cut -f1 -d' '`; + echo "Factorcode md5: $factorcode_md5"; + echo "Disk md5: $disk_md5"; if [[ "$factorcode_md5" == "$disk_md5" ]] ; then echo "Your disk boot image matches the one on factorcode.org." else From 5e695ea4c3552429999785f7b2e8f8659cddd6df Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 13 Feb 2008 15:14:54 -0600 Subject: [PATCH 5/7] builder: use benchmarks. for the report --- extra/builder/builder.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 0c9b0a2aba..eaaf5d87de 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -176,7 +176,7 @@ SYMBOL: build-status "Did not pass test-all: " print "../test-all-vocabs" cat "Benchmarks: " print - "../benchmarks" [ stdio get contents eval ] with-file-in . + "../benchmarks" [ stdio get contents eval ] with-file-in benchmarks. ] with-file-out ; From f28687da0bb54c9789cc99681d838e1f02a45822 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Wed, 13 Feb 2008 15:18:40 -0600 Subject: [PATCH 6/7] builder: fix using --- extra/builder/builder.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index eaaf5d87de..a3e925338f 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -3,7 +3,7 @@ USING: kernel parser io io.files io.launcher io.sockets hashtables math threads arrays system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client combinators bootstrap.image bootstrap.image.download - combinators.cleave ; + combinators.cleave benchmark ; IN: builder From eb756850318654cd04e19c53f4000eb53adca60a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 13 Feb 2008 16:51:16 -0600 Subject: [PATCH 7/7] fix a bug in sqlite add execute-statment-row-id to db some work on postgresql --- extra/db/db.factor | 13 ++- extra/db/postgresql/ffi/ffi.factor | 2 + extra/db/postgresql/lib/lib.factor | 7 +- extra/db/postgresql/postgresql.factor | 109 +++++++++++++++++++++++++- extra/db/sqlite/ffi/ffi.factor | 2 +- extra/db/sqlite/lib/lib.factor | 2 +- extra/db/sqlite/sqlite.factor | 22 ++++-- extra/db/tuples/tuples-tests.factor | 17 ++-- extra/db/tuples/tuples.factor | 11 ++- 9 files changed, 155 insertions(+), 30 deletions(-) diff --git a/extra/db/db.factor b/extra/db/db.factor index 7bdb75af22..46b257ce7a 100755 --- a/extra/db/db.factor +++ b/extra/db/db.factor @@ -15,7 +15,8 @@ TUPLE: db handle insert-statements update-statements delete-statements select-st GENERIC: db-open ( db -- ) HOOK: db-close db ( handle -- ) -: dispose-statements [ dispose drop ] assoc-each ; +: dispose-statements ( seq -- ) + [ dispose drop ] assoc-each ; : dispose-db ( db -- ) dup db [ @@ -35,7 +36,13 @@ HOOK: db ( str -- statement ) GENERIC: prepare-statement ( statement -- ) GENERIC: bind-statement* ( obj statement -- ) GENERIC: reset-statement ( statement -- ) -GENERIC: execute-statement ( statement -- ) +GENERIC: execute-statement* ( statement -- result-set ) +HOOK: last-id db ( res -- id ) +: execute-statement ( statement -- ) + execute-statement* dispose ; + +: execute-statement-last-id ( statement -- id ) + execute-statement* [ last-id ] with-disposal ; : bind-statement ( obj statement -- ) dup statement-bound? [ dup reset-statement ] when @@ -51,8 +58,6 @@ GENERIC: #columns ( result-set -- n ) GENERIC# row-column 1 ( result-set n -- obj ) GENERIC: advance-row ( result-set -- ? ) -HOOK: last-id db ( -- id ) - : init-result-set ( result-set -- ) dup #rows over set-result-set-max -1 swap set-result-set-n ; diff --git a/extra/db/postgresql/ffi/ffi.factor b/extra/db/postgresql/ffi/ffi.factor index 1ec6fc46f8..d14ec13ff8 100755 --- a/extra/db/postgresql/ffi/ffi.factor +++ b/extra/db/postgresql/ffi/ffi.factor @@ -50,6 +50,8 @@ IN: db.postgresql.ffi : PQERRORS_DEFAULT HEX: 1 ; inline : PQERRORS_VERBOSE HEX: 2 ; inline +: InvalidOid 0 ; inline + TYPEDEF: int size_t TYPEDEF: int ConnStatusType TYPEDEF: int ExecStatusType diff --git a/extra/db/postgresql/lib/lib.factor b/extra/db/postgresql/lib/lib.factor index a940a42ae4..d8381ca83a 100644 --- a/extra/db/postgresql/lib/lib.factor +++ b/extra/db/postgresql/lib/lib.factor @@ -37,8 +37,13 @@ IN: db.postgresql.lib >r db get db-handle r> [ statement-sql ] keep [ statement-params length f ] keep - statement-params [ malloc-char-string ] map >c-void*-array + statement-params [ second malloc-char-string ] map >c-void*-array f f 0 PQexecParams dup postgresql-result-ok? [ dup postgresql-result-error-message swap PQclear throw ] unless ; + +: pq-oid-value ( res -- n ) + PQoidValue dup InvalidOid = [ + "postgresql returned an InvalidOid" throw + ] when ; diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index 92e3fa5489..dac4d78b78 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2007, 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs alien alien.syntax continuations io -kernel math namespaces prettyprint quotations -sequences debugger db db.postgresql.lib db.postgresql.ffi ; +kernel math math.parser namespaces prettyprint quotations +sequences debugger db db.postgresql.lib db.postgresql.ffi +db.tuples db.types ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty db user pass ; @@ -51,8 +52,8 @@ M: postgresql-result-set #columns ( result-set -- n ) M: postgresql-result-set row-column ( result-set n -- obj ) >r dup result-set-handle swap result-set-n r> PQgetvalue ; -M: postgresql-statement execute-statement ( statement -- ) - query-results dispose ; +M: postgresql-statement execute-statement* ( statement -- obj ) + query-results ; : increment-n ( result-set -- n ) dup result-set-n 1+ dup rot set-result-set-n ; @@ -103,3 +104,103 @@ M: postgresql-db commit-transaction ( -- ) M: postgresql-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; + + +M: postgresql-db create-sql ( columns table -- sql ) + [ + "create table " % % + " (" % [ ", " % ] [ + dup second % " " % + dup third >sql-type % " " % + sql-modifiers " " join % + ] interleave ")" % + ] "" make ; + +M: postgresql-db drop-sql ( table -- sql ) + [ + "drop table " % % + ] "" make ; + +SYMBOL: postgresql-counter + +M: postgresql-db insert-sql* ( columns table -- sql ) + [ + postgresql-counter off + "insert into " % + % + "(" % + dup [ ", " % ] [ second % ] interleave + ") " % + " values (" % + [ ", " % ] [ + drop "$" % postgresql-counter [ inc ] keep get # + ] interleave + ")" % + ] "" make ; + +M: postgresql-db update-sql* ( columns table -- sql ) + [ + "update " % + % + " set " % + dup remove-id + [ ", " % ] [ second dup % " = :" % % ] interleave + " where " % + [ primary-key? ] find nip second dup % " = :" % % + ] "" make ; + +M: postgresql-db delete-sql* ( columns table -- sql ) + [ + "delete from " % + % + " where " % + first second dup % " = :" % % + ] "" make ; + +M: postgresql-db select-sql* ( columns table -- sql ) + drop ; + +M: postgresql-db tuple>params ( columns tuple -- obj ) + [ + >r dup first r> get-slot-named swap third + ] curry { } map>assoc ; + +M: postgresql-db last-id ( res -- id ) + pq-oid-value ; + +: postgresql-db-modifiers ( -- hashtable ) + H{ + { +native-id+ "primary key" } + { +assigned-id+ "primary key" } + { +autoincrement+ "autoincrement" } + { +unique+ "unique" } + { +default+ "default" } + { +null+ "null" } + { +not-null+ "not null" } + } ; + +M: postgresql-db sql-modifiers* ( modifiers -- str ) + postgresql-db-modifiers swap [ + dup array? [ + first2 + >r swap at r> number>string* + " " swap 3append + ] [ + swap at + ] if + ] with map [ ] subset ; + +: postgresql-type-hash ( -- assoc ) + H{ + { INTEGER "integer" } + { TEXT "text" } + { VARCHAR "text" } + { DOUBLE "real" } + } ; + +M: postgresql-db >sql-type ( obj -- str ) + dup pair? [ + first >sql-type + ] [ + postgresql-type-hash at* [ T{ no-sql-type } throw ] unless + ] if ; diff --git a/extra/db/sqlite/ffi/ffi.factor b/extra/db/sqlite/ffi/ffi.factor index 9ffe797248..3d37348709 100755 --- a/extra/db/sqlite/ffi/ffi.factor +++ b/extra/db/sqlite/ffi/ffi.factor @@ -108,7 +108,7 @@ LIBRARY: sqlite FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ; FUNCTION: int sqlite3_close ( sqlite3* pDb ) ; FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ; -FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ; +FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ; FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ; FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index 1780cc4a2d..e97dcf80c9 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -30,7 +30,7 @@ IN: db.sqlite.lib : sqlite-prepare ( db sql -- handle ) dup length "void*" "void*" - [ sqlite3_prepare_v2 sqlite-check-result ] 2keep + [ sqlite3_prepare sqlite-check-result ] 2keep drop *void* ; : sqlite-bind-parameter-index ( handle name -- index ) diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index ad3a43bae3..f58c669681 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -25,7 +25,7 @@ M: sqlite-db dispose ( db -- ) dispose-db ; TUPLE: sqlite-statement ; C: sqlite-statement -TUPLE: sqlite-result-set ; +TUPLE: sqlite-result-set advanced? ; : ( query -- sqlite-result-set ) dup statement-handle sqlite-result-set ; @@ -40,7 +40,13 @@ M: sqlite-db ( str -- obj ) M: sqlite-statement dispose ( statement -- ) statement-handle sqlite-finalize ; +: maybe-advance-row ( result-set -- result-set ) + dup sqlite-result-set-advanced? [ + dup advance-row drop + ] unless ; + M: sqlite-result-set dispose ( result-set -- ) + maybe-advance-row f swap set-result-set-handle ; : sqlite-bind ( triples handle -- ) @@ -52,8 +58,8 @@ M: sqlite-statement bind-statement* ( triples statement -- ) M: sqlite-statement reset-statement ( statement -- ) statement-handle sqlite-reset ; -M: sqlite-statement execute-statement ( statement -- ) - statement-handle sqlite-next drop ; +M: sqlite-statement execute-statement* ( statement -- obj ) + query-results ; M: sqlite-result-set #columns ( result-set -- n ) result-set-handle sqlite-#columns ; @@ -62,7 +68,8 @@ M: sqlite-result-set row-column ( result-set n -- obj ) >r result-set-handle r> sqlite-column ; M: sqlite-result-set advance-row ( result-set -- handle ? ) - result-set-handle sqlite-next ; + [ result-set-handle sqlite-next ] keep + t swap set-sqlite-result-set-advanced? ; M: sqlite-statement query-results ( query -- result-set ) dup statement-handle sqlite-result-set ; @@ -138,9 +145,10 @@ M: sqlite-db tuple>params ( columns tuple -- obj ) third 3array ] curry map ; -M: sqlite-db last-id ( -- id ) - db get db-handle sqlite3_last_insert_rowid ; - +M: sqlite-db last-id ( result-set -- id ) + maybe-advance-row drop + db get db-handle sqlite3_last_insert_rowid + dup zero? [ "last-id failed" throw ] when ; : sqlite-db-modifiers ( -- hashtable ) H{ diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 474593ae3f..6945ccc722 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -1,11 +1,12 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel tools.test db db.sqlite db.tuples -db.types continuations namespaces ; +db.types continuations namespaces db.postgresql math +tools.time ; IN: temporary TUPLE: person the-id the-name the-number real ; -: ( name age -- person ) +: ( name age real -- person ) { set-person-the-name set-person-the-number @@ -36,10 +37,10 @@ SYMBOL: the-person test-tuples ] with-db ; -! : test-postgres ( -- ) - ! resource-path [ - ! test-tuples - ! ] with-db ; +: test-postgresql ( -- ) + "localhost" "postgres" "" "factor-test" [ + test-tuples + ] with-db ; person "PERSON" { @@ -52,7 +53,7 @@ person "PERSON" "billy" 10 3.14 the-person set test-sqlite -! test-postgres +! test-postgresql person "PERSON" { @@ -65,4 +66,4 @@ person "PERSON" 1 "billy" 20 6.28 the-person set test-sqlite -! test-postgres +! test-postgresql diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 099326e4c1..783001f3f8 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -64,9 +64,12 @@ HOOK: tuple>params db ( columns tuple -- obj ) 2dup . . [ bind-statement ] keep ; -: do-tuple-statement ( tuple columns-quot statement-quot -- ) +: make-tuple-statement ( tuple columns-quot statement-quot -- statement ) >r [ class db-columns ] swap compose keep - r> tuple-statement execute-statement ; + r> tuple-statement ; + +: do-tuple-statement ( tuple columns-quot statement-quot -- ) + make-tuple-statement execute-statement ; : create-table ( class -- ) dup db-columns swap db-table create-sql sql-command ; @@ -76,8 +79,8 @@ HOOK: tuple>params db ( columns tuple -- obj ) : insert-tuple ( tuple -- ) [ - [ maybe-remove-id ] [ insert-sql ] do-tuple-statement - last-id + [ maybe-remove-id ] [ insert-sql ] + make-tuple-statement execute-statement-last-id ] keep set-primary-key ; : update-tuple ( tuple -- )