Support Chicken 5

- Add egg file
- Adjust list of imported modules based on Chicken version

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)))

ssql-postgresql.scm

@@ -2,8 +2,12 @@
 
 (*postgresql-translator*)
 
-(import chicken scheme)
+(cond-expand
-(use ssql postgresql foops data-structures)
+  (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*)
 
-)
+)

tests/run.scm

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

@@ -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"))))))