From b8eb5abd13b84a068a33b30fb928d87ed83f569d Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 5 Mar 2008 20:56:40 -0600
Subject: [PATCH] before major query overhaul
---
extra/db/sqlite/sqlite.factor | 12 +++-----
extra/db/tuples/tuples-tests.factor | 48 +++++++++++++++++++++++------
2 files changed, 44 insertions(+), 16 deletions(-)
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 1524ee5a4f..643b42165d 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -142,6 +142,10 @@ M: sqlite-db <insert-assigned-statement> ( tuple -- statement )
" where " 0%
find-primary-key dup sql-spec-column-name 0% " = " 0% bind% ;
+: where-clause ( specs -- )
+ " where " 0%
+ [ " and " 0% ] [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave ;
+
M: sqlite-db <update-tuple-statement> ( class -- statement )
[
"update " 0%
@@ -174,13 +178,7 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
" from " 0% 0%
[ sql-spec-slot-name swap get-slot-named ] with subset
- dup empty? [
- drop
- ] [
- " where " 0%
- [ ", " 0% ]
- [ dup sql-spec-column-name 0% " = " 0% bind% ] interleave
- ] if ";" 0%
+ dup empty? [ drop ] [ where-clause ] if ";" 0%
] 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 c9ceffe035..3a1e2c4f25 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel tools.test db db.tuples
db.types continuations namespaces db.postgresql math
-prettyprint tools.walker db.sqlite calendar ;
+prettyprint tools.walker db.sqlite calendar
+math.intervals ;
IN: db.tuples.tests
TUPLE: person the-id the-name the-number the-real ts date time blob ;
-: <person> ( name age real -- person )
+: <person> ( name age real ts date time blob -- person )
{
set-person-the-name
set-person-the-number
@@ -17,7 +18,7 @@ TUPLE: person the-id the-name the-number the-real ts date time blob ;
set-person-blob
} person construct ;
-: <assigned-person> ( id name number the-real -- obj )
+: <assigned-person> ( id name age real ts date time blob -- person )
<person> [ set-person-the-id ] keep ;
SYMBOL: person1
@@ -54,6 +55,12 @@ SYMBOL: person4
}
] [ T{ person f } select-tuples ] unit-test
+ [
+ {
+ T{ person f 2 "johnny" 10 3.14 }
+ }
+ ] [ T{ person f f f 10 3.14 } select-tuples ] unit-test
+
[ ] [ person1 get delete-tuple ] unit-test
[ f ] [ T{ person f 1 } select-tuple ] unit-test
@@ -151,19 +158,18 @@ TUPLE: annotation n paste-id summary author mode contents ;
! [ ] [ 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
TUPLE: serialize-me id data ;
-[
+
+: test-serialize ( -- )
serialize-me "SERIALIZED"
{
{ "id" "ID" +native-id+ }
@@ -175,7 +181,31 @@ TUPLE: serialize-me id data ;
[ ] [ T{ serialize-me f f H{ { 1 2 } } } insert-tuple ] unit-test
[
{ T{ serialize-me f 1 H{ { 1 2 } } } }
- ] [ T{ serialize-me f 1 } select-tuples ] unit-test
-] test-sqlite
+ ] [ T{ serialize-me f 1 } select-tuples ] unit-test ;
-! [ make-native-person-table ] test-sqlite
+! [ test-serialize ] test-sqlite
+
+TUPLE: exam id name score ;
+
+: test-ranges ( -- )
+ exam "EXAM"
+ {
+ { "id" "ID" +native-id+ }
+ { "name" "NAME" TEXT }
+ { "score" "SCORE" INTEGER }
+ } define-persistent
+ [ exam drop-table ] [ drop ] recover
+ [ ] [ exam create-table ] unit-test
+
+ [ ] [ T{ exam f f "Kyle" 100 } insert-tuple ] unit-test
+ [ ] [ T{ exam f f "Stan" 80 } insert-tuple ] unit-test
+ [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test
+ [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test
+
+ [
+ T{ exam f 3 "Kenny" 60 }
+ T{ exam f 4 "Cartman" 41 }
+ ] [ T{ exam f 4 f T{ interval f { 0 t } { 70 t } } } select-tuples ] unit-test
+ ;
+
+! [ test-ranges ] test-sqlite