From 19d771f8276e327df252d599c03381c30cb7b8da Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 25 Feb 2008 15:13:00 -0600 Subject: [PATCH] re-add delete-tuple make all unit tests pass for assigned-id --- extra/db/postgresql/postgresql.factor | 6 +-- extra/db/tuples/tuples-tests.factor | 57 ++++++++++++++------------- extra/db/tuples/tuples.factor | 10 ++++- 3 files changed, 41 insertions(+), 32 deletions(-) diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor index e5bb3b0695..154a330913 100755 --- a/extra/db/postgresql/postgresql.factor +++ b/extra/db/postgresql/postgresql.factor @@ -161,7 +161,7 @@ M: postgresql-db create-sql-statement ( class -- seq ) [ [ create-table-sql , ] keep dup db-columns find-primary-key native-id? - [ create-function-sql , ] [ 2drop ] if + [ create-function-sql , ] [ drop ] if ] { } make ; : drop-function-sql ( class -- statement ) @@ -176,13 +176,13 @@ M: postgresql-db create-sql-statement ( class -- seq ) : drop-table-sql ( table -- statement ) [ "drop table " 0% 0% ";" 0% drop - ] postgresql-make dup . ; + ] postgresql-make ; M: postgresql-db drop-sql-statement ( class -- seq ) [ [ drop-table-sql , ] keep dup db-columns find-primary-key native-id? - [ drop-function-sql , ] [ 2drop ] if + [ drop-function-sql , ] [ drop ] if ] { } make ; M: postgresql-db ( class -- statement ) diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index 82bc96e156..d5f6386e8e 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -16,29 +16,30 @@ TUPLE: person the-id the-name the-number the-real ; : ( id name number the-real -- obj ) [ set-person-the-id ] keep ; -SYMBOL: the-person +SYMBOL: the-person1 +SYMBOL: the-person2 : test-tuples ( -- ) [ person drop-table ] [ drop ] recover [ ] [ person create-table ] unit-test - [ ] [ the-person get insert-tuple ] unit-test + [ ] [ the-person1 get insert-tuple ] unit-test - [ 1 ] [ the-person get person-the-id ] unit-test + [ 1 ] [ the-person1 get person-the-id ] unit-test - 200 the-person get set-person-the-number + 200 the-person1 get set-person-the-number - [ ] [ the-person get update-tuple ] unit-test + [ ] [ the-person1 get update-tuple ] unit-test [ T{ person f 1 "billy" 200 3.14 } ] [ T{ person f 1 } select-tuple ] unit-test - ! [ ] [ the-person get delete-tuple ] unit-test - ! [ ] [ person drop-table ] 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 [ + "tuples-test.db" resource-path sqlite-db [ test-tuples ] with-db ; @@ -55,23 +56,24 @@ person "PERSON" { "the-real" "REAL" DOUBLE { +default+ 0.3 } } } define-persistent -"billy" 10 3.14 the-person set +"billy" 10 3.14 the-person1 set +"johnny" 10 3.14 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 +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" 20 6.28 the-person set +1 "billy" 10 3.14 the-person1 set ! test-sqlite -! test-postgresql +test-postgresql TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; @@ -98,11 +100,12 @@ annotation "ANNOTATION" { "contents" "CONTENTS" TEXT } } define-persistent -! "localhost" "postgres" "" "factor-test" [ - ! [ paste drop-table ] [ drop ] recover - ! [ annotation drop-table ] [ drop ] recover - ! [ paste drop-table ] [ drop ] recover - ! [ annotation drop-table ] [ drop ] recover - ! [ ] [ paste create-table ] unit-test - ! [ ] [ annotation create-table ] unit-test -! ] with-db +{ "localhost" "postgres" "" "factor-test" } postgresql-db [ + [ paste drop-table ] [ drop ] recover + [ annotation drop-table ] [ drop ] recover + [ paste drop-table ] [ drop ] recover + [ annotation drop-table ] [ drop ] recover + [ ] [ paste create-table ] unit-test + [ ] [ annotation create-table ] unit-test +] with-db + diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index a7f2abf8b8..f0ee23e728 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -92,7 +92,13 @@ HOOK: insert-tuple* db ( tuple statement -- ) execute-statement ; : persist ( tuple -- ) - dup class db-columns find-primary-key ; + dup class db-columns find-primary-key + sql-spec-slot-name over get-slot-named + [ update-tuple ] [ insert-tuple ] if ; + +: delete-tuple ( tuple -- ) + dup class + [ bind-tuple ] keep execute-statement ; : setup-select ( tuple -- statement ) @@ -100,4 +106,4 @@ HOOK: insert-tuple* db ( tuple statement -- ) [ bind-tuple ] keep ; : select-tuples ( tuple -- tuple ) setup-select query-tuples ; -: select-tuple ( tuple -- tuple ) select-tuples first ; +: select-tuple ( tuple -- tuple/f ) select-tuples ?first ;