From 15947d68535df0484db54ebd1ed4a7b5aefaa153 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 3 Mar 2008 08:56:06 -0600
Subject: [PATCH] start moving db to new-slots redo the tuple tests so it's a
bit easier to work with fix a bug where selecting based on an empty tuple
wouldn't work
---
extra/db/db.factor | 33 +++-----
extra/db/sqlite/sqlite.factor | 14 ++--
extra/db/tuples/tuples-tests.factor | 120 +++++++++++++++-------------
3 files changed, 88 insertions(+), 79 deletions(-)
diff --git a/extra/db/db.factor b/extra/db/db.factor
index a577ff5fc5..e834144d0c 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs classes continuations kernel math
namespaces sequences sequences.lib tuples words strings
-tools.walker ;
+tools.walker new-slots accessors ;
IN: db
TUPLE: db
@@ -25,10 +25,10 @@ HOOK: db-close db ( handle -- )
: dispose-db ( db -- )
dup db [
- dup db-insert-statements dispose-statements
- dup db-update-statements dispose-statements
- dup db-delete-statements dispose-statements
- db-handle db-close
+ dup insert-statements>> dispose-statements
+ dup update-statements>> dispose-statements
+ dup delete-statements>> dispose-statements
+ handle>> db-close
] with-variable ;
TUPLE: statement handle sql in-params out-params bind-params bound? ;
@@ -36,11 +36,7 @@ TUPLE: simple-statement ;
TUPLE: prepared-statement ;
TUPLE: result-set sql params handle n max ;
: <statement> ( sql in out -- statement )
- {
- set-statement-sql
- set-statement-in-params
- set-statement-out-params
- } statement construct ;
+ { (>>sql) (>>in-params) (>>out-params) } statement construct ;
HOOK: <simple-statement> db ( str in out -- statement )
HOOK: <prepared-statement> db ( str in out -- statement )
@@ -62,21 +58,18 @@ GENERIC: more-rows? ( result-set -- ? )
] if ;
: bind-statement ( obj statement -- )
- [ set-statement-bind-params ] keep
+ swap >>bind-params
[ bind-statement* ] keep
- t swap set-statement-bound? ;
+ t >>bound? drop ;
: init-result-set ( result-set -- )
- dup #rows over set-result-set-max
- 0 swap set-result-set-n ;
+ dup #rows >>max
+ 0 >>n drop ;
: <result-set> ( query handle tuple -- result-set )
- >r >r { statement-sql statement-in-params } get-slots r>
- {
- set-result-set-sql
- set-result-set-params
- set-result-set-handle
- } result-set construct r> construct-delegate ;
+ >r >r { sql>> in-params>> } get-slots r>
+ { (>>sql) (>>params) (>>handle) } result-set
+ construct r> construct-delegate ;
: sql-row ( result-set -- seq )
dup #columns [ row-column ] with map ;
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index c03496530b..cfdcfc7750 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -5,7 +5,7 @@ hashtables io.files kernel math math.parser namespaces
prettyprint sequences strings tuples alien.c-types
continuations db.sqlite.lib db.sqlite.ffi db.tuples
words combinators.lib db.types combinators tools.walker
-combinators.cleave ;
+combinators.cleave io ;
IN: db.sqlite
TUPLE: sqlite-db path ;
@@ -173,10 +173,14 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
" from " 0% 0%
[ sql-spec-slot-name swap get-slot-named ] with subset
- " where " 0%
- [ ", " 0% ]
- [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
- ";" 0%
+ dup empty? [
+ drop
+ ] [
+ " where " 0%
+ [ ", " 0% ]
+ [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
+ ";" 0%
+ ] if
] sqlite-make ;
M: sqlite-db modifier-table ( -- hashtable )
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index aa94bbfbb6..517f8bcc36 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -41,73 +41,73 @@ SYMBOL: the-person2
T{ person f 2 "johnny" 10 3.14 }
}
] [ T{ person f f f f 3.14 } select-tuples ] unit-test
+ [
+ {
+ T{ person f 1 "billy" 200 3.14 }
+ T{ person f 2 "johnny" 10 3.14 }
+ }
+ ] [ T{ person f } select-tuples ] unit-test
+
[ ] [ the-person1 get delete-tuple ] unit-test
[ f ] [ T{ person f 1 } select-tuple ] unit-test
[ ] [ person drop-table ] unit-test ;
-: test-sqlite ( -- )
- "tuples-test.db" resource-path sqlite-db [
- test-tuples
- ] with-db ;
+: make-native-person-table ( -- )
+ [ person drop-table ] [ drop ] recover
+ person create-table
+ T{ person f f "billy" 200 3.14 } insert-tuple
+ T{ person f f "johnny" 10 3.14 } insert-tuple
+ ;
-: test-postgresql ( -- )
- { "localhost" "postgres" "" "factor-test" } postgresql-db [
- test-tuples
- ] with-db ;
+: native-person-schema ( -- )
+ person "PERSON"
+ {
+ { "the-id" "ID" +native-id+ }
+ { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+ { "the-number" "AGE" INTEGER { +default+ 0 } }
+ { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+ } define-persistent
+ "billy" 10 3.14 <person> the-person1 set
+ "johnny" 10 3.14 <person> the-person2 set ;
-person "PERSON"
-{
- { "the-id" "ID" +native-id+ }
- { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
- { "the-number" "AGE" INTEGER { +default+ 0 } }
- { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-} define-persistent
+: assigned-person-schema ( -- )
+ person "PERSON"
+ {
+ { "the-id" "ID" INTEGER +assigned-id+ }
+ { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+ { "the-number" "AGE" INTEGER { +default+ 0 } }
+ { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
+ } define-persistent
+ 1 "billy" 10 3.14 <assigned-person> the-person1 set
+ 2 "johnny" 10 3.14 <assigned-person> the-person2 set ;
-"billy" 10 3.14 <person> the-person1 set
-"johnny" 10 3.14 <person> the-person2 set
-
-test-sqlite
-! test-postgresql
-
-person "PERSON"
-{
- { "the-id" "ID" INTEGER +assigned-id+ }
- { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
- { "the-number" "AGE" INTEGER { +default+ 0 } }
- { "the-real" "REAL" DOUBLE { +default+ 0.3 } }
-} define-persistent
-
-1 "billy" 10 3.14 <assigned-person> the-person1 set
-2 "johnny" 10 3.14 <assigned-person> the-person2 set
-
-test-sqlite
-! test-postgresql
TUPLE: paste n summary author channel mode contents timestamp annotations ;
TUPLE: annotation n paste-id summary author mode contents ;
-paste "PASTE"
-{
- { "n" "ID" +native-id+ }
- { "summary" "SUMMARY" TEXT }
- { "author" "AUTHOR" TEXT }
- { "channel" "CHANNEL" TEXT }
- { "mode" "MODE" TEXT }
- { "contents" "CONTENTS" TEXT }
- { "date" "DATE" TIMESTAMP }
- { "annotations" { +has-many+ annotation } }
-} define-persistent
+: native-paste-schema ( -- )
+ paste "PASTE"
+ {
+ { "n" "ID" +native-id+ }
+ { "summary" "SUMMARY" TEXT }
+ { "author" "AUTHOR" TEXT }
+ { "channel" "CHANNEL" TEXT }
+ { "mode" "MODE" TEXT }
+ { "contents" "CONTENTS" TEXT }
+ { "date" "DATE" TIMESTAMP }
+ { "annotations" { +has-many+ annotation } }
+ } define-persistent
-annotation "ANNOTATION"
-{
- { "n" "ID" +native-id+ }
- { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
- { "summary" "SUMMARY" TEXT }
- { "author" "AUTHOR" TEXT }
- { "mode" "MODE" TEXT }
- { "contents" "CONTENTS" TEXT }
-} define-persistent
+ annotation "ANNOTATION"
+ {
+ { "n" "ID" +native-id+ }
+ { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } }
+ { "summary" "SUMMARY" TEXT }
+ { "author" "AUTHOR" TEXT }
+ { "mode" "MODE" TEXT }
+ { "contents" "CONTENTS" TEXT }
+ } define-persistent ;
! { "localhost" "postgres" "" "factor-test" } postgresql-db [
! [ paste drop-table ] [ drop ] recover
@@ -117,3 +117,15 @@ annotation "ANNOTATION"
! [ ] [ paste create-table ] unit-test
! [ ] [ annotation create-table ] unit-test
! ] with-db
+
+
+: test-sqlite ( quot -- )
+ >r "tuples-test.db" resource-path sqlite-db r> with-db ;
+
+: test-postgresql ( -- )
+ >r { "localhost" "postgres" "" "factor-test" } postgresql-db r> with-db ;
+
+[ native-person-schema test-tuples ] test-sqlite
+[ assigned-person-schema test-tuples ] test-sqlite
+
+! [ make-native-person-table ] test-sqlite