From 7f766a0c204f5d28f9217eda8ce7b45ad6a2fbc3 Mon Sep 17 00:00:00 2001 From: Your Name Date: Tue, 27 Aug 2019 00:59:27 +0700 Subject: [PATCH] Support Chicken 5 - Add egg file - Adjust list of imported modules based on Chicken version --- ssql-postgresql.egg | 8 ++++++ ssql-postgresql.scm | 10 +++++--- tests/run.scm | 62 +++++++++------------------------------------ tests/test.scm | 45 ++++++++++++++++++++++++++++++++ 4 files changed, 72 insertions(+), 53 deletions(-) create mode 100644 ssql-postgresql.egg create mode 100644 tests/test.scm diff --git a/ssql-postgresql.egg b/ssql-postgresql.egg new file mode 100644 index 0000000..c02570f --- /dev/null +++ b/ssql-postgresql.egg @@ -0,0 +1,8 @@ +((version "0.1.2") + (synopsis "SSQL translator for PostgreSQL") + (category db) + (dependencies ssql postgresql) + (test-dependencies test) + (license "BSD") + (author "Peter Bex, Moritz Heidkamp") + (components (extension ssql-postgresql))) diff --git a/ssql-postgresql.scm b/ssql-postgresql.scm index 920b196..3212a82 100644 --- a/ssql-postgresql.scm +++ b/ssql-postgresql.scm @@ -2,8 +2,12 @@ (*postgresql-translator*) -(import chicken scheme) -(use ssql postgresql foops data-structures) +(cond-expand + (chicken-4 + (import chicken scheme) + (use ssql postgresql foops data-structures)) + (chicken-5 + (import scheme ssql postgresql foops (chicken format) (chicken string)))) (define *postgresql-translator* (let ((type->sql-converters @@ -41,4 +45,4 @@ (register-sql-engine! connection? *postgresql-translator*) -) \ No newline at end of file +) diff --git a/tests/run.scm b/tests/run.scm index d2db4d4..a5af338 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,50 +1,12 @@ -(load-relative "../ssql-postgresql") -(use ssql) -(import ssql-postgresql) -(use test postgresql foops) - -(define *test-postgresql-translator* - (derive-object (*postgresql-translator* self super) - ((escape-string string) - (string-translate* string '(("'" . "''")))))) - -(register-sql-engine! (lambda (x) (eq? x #t)) *test-postgresql-translator*) - -(test-group "selects" - (test "Simple query" - "SELECT actors.firstname, actors.lastname FROM actors" - (ssql->sql #t `(select (columns actors.firstname actors.lastname) - (from actors))))) - -(test-group "dialect" - (test "LIMIT and OFFSET" - "SELECT * FROM integers LIMIT 10 OFFSET 100" - (ssql->sql #t `(select (columns *) (from integers) (limit 10) (offset 100)))) - - (test "random()" - "SELECT * FROM widgets ORDER BY RANDOM()" - (ssql->sql #t `(select (columns *) (from widgets) (order (random))))) - - (test "returning" - "INSERT INTO widgets VALUES ('foo', 'bar') RETURNING id, name" - (ssql->sql #t '(insert (into widgets) (values #("foo" "bar")) (returning id name)))) - - (test "compose returning" - '(insert (into widgets) (values #(1 2 3)) (returning id)) - (ssql-compose #t '(insert (into widgets) (values #(1 2 3))) '((returning id))))) - - -(test-group "arrays" - (test "literals" - "SELECT ARRAY[1, 2, 3]" - (ssql->sql #t '(select (array 1 2 3)))) - - (test "contains operator" - "SELECT (ARRAY['foo', 'bar'] @> ARRAY['bar'])" - (ssql->sql #t '(select (@> (array "foo" "bar") (array "bar"))))) - - (test "is contained operator" - "SELECT (ARRAY['bar'] <@ ARRAY['foo', 'bar'])" - (ssql->sql #t '(select (<@ (array "bar") (array "foo" "bar")))))) - -(test-exit) \ No newline at end of file +(cond-expand + (chicken-4 + (load-relative "../ssql-postgresql") + (use ssql) + (import ssql-postgresql) + (use test postgresql foops)) + (chicken-5 + (import test (chicken load) (chicken platform)) + (repository-path (cons ".." (repository-path))))) + +(load "test.scm") +(test-exit) diff --git a/tests/test.scm b/tests/test.scm new file mode 100644 index 0000000..bcb70ef --- /dev/null +++ b/tests/test.scm @@ -0,0 +1,45 @@ +(import postgresql foops ssql ssql-postgresql (chicken string)) + +(define *test-postgresql-translator* + (derive-object (*postgresql-translator* self super) + ((escape-string string) + (string-translate* string '(("'" . "''")))))) + +(register-sql-engine! (lambda (x) (eq? x #t)) *test-postgresql-translator*) + +(test-group "selects" + (test "Simple query" + "SELECT actors.firstname, actors.lastname FROM actors" + (ssql->sql #t `(select (columns actors.firstname actors.lastname) + (from actors))))) + +(test-group "dialect" + (test "LIMIT and OFFSET" + "SELECT * FROM integers LIMIT 10 OFFSET 100" + (ssql->sql #t `(select (columns *) (from integers) (limit 10) (offset 100)))) + + (test "random()" + "SELECT * FROM widgets ORDER BY RANDOM()" + (ssql->sql #t `(select (columns *) (from widgets) (order (random))))) + + (test "returning" + "INSERT INTO widgets VALUES ('foo', 'bar') RETURNING id, name" + (ssql->sql #t '(insert (into widgets) (values #("foo" "bar")) (returning id name)))) + + (test "compose returning" + '(insert (into widgets) (values #(1 2 3)) (returning id)) + (ssql-compose #t '(insert (into widgets) (values #(1 2 3))) '((returning id))))) + + +(test-group "arrays" + (test "literals" + "SELECT ARRAY[1, 2, 3]" + (ssql->sql #t '(select (array 1 2 3)))) + + (test "contains operator" + "SELECT (ARRAY['foo', 'bar'] @> ARRAY['bar'])" + (ssql->sql #t '(select (@> (array "foo" "bar") (array "bar"))))) + + (test "is contained operator" + "SELECT (ARRAY['bar'] <@ ARRAY['foo', 'bar'])" + (ssql->sql #t '(select (<@ (array "bar") (array "foo" "bar"))))))