ssql-postgresql.egg

@@ -1,8 +0,0 @@
-((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)))

ssql-postgresql.scm

@@ -2,12 +2,8 @@
 
 (*postgresql-translator*)
 
-(cond-expand
+(import chicken scheme)
-  (chicken-4
+(use ssql postgresql foops data-structures)
-    (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 
@@ -45,4 +41,4 @@
 
 (register-sql-engine! connection? *postgresql-translator*)
 
-)
+)

tests/run.scm

@@ -1,12 +1,50 @@
-(cond-expand
+(load-relative "../ssql-postgresql")
-  (chicken-4
+(use ssql)
-    (load-relative "../ssql-postgresql")
+(import ssql-postgresql)
-    (use ssql)
+(use test postgresql foops)
-    (import ssql-postgresql)
+
-    (use test postgresql foops))
+(define *test-postgresql-translator* 
-  (chicken-5
+  (derive-object (*postgresql-translator* self super)
-    (import test (chicken load) (chicken platform))
+                 ((escape-string string)
-    (repository-path (cons ".." (repository-path)))))
+                  (string-translate* string '(("'" . "''"))))))
-
+
-(load "test.scm")
+(register-sql-engine! (lambda (x) (eq? x #t)) *test-postgresql-translator*)
-(test-exit)
+
+(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)

tests/test.scm

@@ -1,45 +0,0 @@
-(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"))))))