From 880a3a2af41ebbec3274eccf3c840e25457de3b8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 17 Mar 2008 14:14:04 -0500
Subject: [PATCH] before major refactoring
---
extra/db/sqlite/lib/lib.factor | 1 +
extra/db/sqlite/sqlite.factor | 2 ++
extra/db/tuples/tuples-tests.factor | 42 ++++++++++++++++++++---------
extra/db/types/types.factor | 2 --
4 files changed, 33 insertions(+), 14 deletions(-)
diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor
index 0e512ad018..f81d7de4b8 100755
--- a/extra/db/sqlite/lib/lib.factor
+++ b/extra/db/sqlite/lib/lib.factor
@@ -121,6 +121,7 @@ IN: db.sqlite.lib
dup array? [ first ] when
{
{ +native-id+ [ sqlite3_column_int64 ] }
+ { +random-id+ [ sqlite3_column_int64 ] }
{ INTEGER [ sqlite3_column_int ] }
{ BIG-INTEGER [ sqlite3_column_int64 ] }
{ DOUBLE [ sqlite3_column_double ] }
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 1b594d6fa4..bca904279b 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -190,6 +190,7 @@ M: sqlite-db modifier-table ( -- hashtable )
H{
{ +native-id+ "primary key" }
{ +assigned-id+ "primary key" }
+ { +random-id+ "primary key" }
! { +nonnative-id+ "primary key" }
{ +autoincrement+ "autoincrement" }
{ +unique+ "unique" }
@@ -209,6 +210,7 @@ M: sqlite-db compound-type ( str seq -- str' )
M: sqlite-db type-table ( -- assoc )
H{
{ +native-id+ "integer primary key" }
+ { +random-id+ "integer primary key" }
{ INTEGER "integer" }
{ TEXT "text" }
{ VARCHAR "text" }
diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor
index 2dbf6d1008..6b61981119 100755
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@@ -196,13 +196,6 @@ TUPLE: annotation n paste-id summary author mode contents ;
[ ] [ person1 get insert-tuple ] unit-test
[ person1 get insert-tuple ] must-fail ;
-[ native-person-schema test-tuples ] test-sqlite
-[ assigned-person-schema test-tuples ] test-sqlite
-[ native-person-schema test-tuples ] test-postgresql
-[ assigned-person-schema test-tuples ] test-postgresql
-[ assigned-person-schema test-repeated-insert ] test-sqlite
-[ assigned-person-schema test-repeated-insert ] test-postgresql
-
TUPLE: serialize-me id data ;
: test-serialize ( -- )
@@ -247,8 +240,33 @@ TUPLE: exam id name score ;
! [ test-ranges ] test-sqlite
-\ insert-tuple must-infer
-\ update-tuple must-infer
-\ delete-tuple must-infer
-\ select-tuple must-infer
-\ define-persistent must-infer
+TUPLE: secret n message ;
+C: <secret> secret
+
+: test-random-id
+ secret "SECRET"
+ {
+ { "n" "ID" +random-id+ }
+ { "message" "MESSAGE" TEXT }
+ } define-persistent
+
+ [ ] [ secret ensure-table ] unit-test
+ [ ] [ f "kilroy was here" <secret> insert-tuple ] unit-test
+ [ ] [ T{ secret } select-tuples ] unit-test
+ ;
+
+
+
+! [ test-random-id ] test-sqlite
+ [ native-person-schema test-tuples ] test-sqlite
+ [ assigned-person-schema test-tuples ] test-sqlite
+! [ assigned-person-schema test-repeated-insert ] test-sqlite
+! [ native-person-schema test-tuples ] test-postgresql
+! [ assigned-person-schema test-tuples ] test-postgresql
+! [ assigned-person-schema test-repeated-insert ] test-postgresql
+
+! \ insert-tuple must-infer
+! \ update-tuple must-infer
+! \ delete-tuple must-infer
+! \ select-tuple must-infer
+! \ define-persistent must-infer
diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor
index 532c097957..a0414f334d 100755
--- a/extra/db/types/types.factor
+++ b/extra/db/types/types.factor
@@ -15,14 +15,12 @@ HOOK: compound-type db ( str n -- hash )
TUPLE: sql-spec class slot-name column-name type modifiers primary-key ;
-
SINGLETON: +native-id+
SINGLETON: +assigned-id+
SINGLETON: +random-id+
UNION: +primary-key+ +native-id+ +assigned-id+ +random-id+ ;
UNION: +nonnative-id+ +random-id+ +assigned-id+ ;
-! +native-id+ +assigned-id+ +random-assigned-id+
SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+
+foreign-id+ +has-many+ ;