Support Chicken 5

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

foops.scm

@@ -2,11 +2,16 @@
 
 (make-object derive-object)
 
-(import chicken scheme)
+(cond-expand
-(use matchable)
+  (chicken-4
-(import-for-syntax chicken)
+    (import chicken scheme)
-(begin-for-syntax
+    (import-for-syntax chicken)
- (use srfi-1))
+    (use matchable)
+    (begin-for-syntax
+     (use srfi-1)))
+  (chicken-5
+    (import-for-syntax srfi-1)
+    (import scheme matchable (chicken syntax))))
 
 (define-for-syntax args-without-self 
   '(if (and (pair? args) (procedure? (car args)))
@@ -53,4 +58,4 @@
         . ,(cadr x))
        . ,(cddr x)))))
 
-)
+)

ssql.egg

@@ -0,0 +1,9 @@
+((version "0.2.4")
+ (synopsis "SQL as S-expressions")
+ (author "Peter Bex, Moritz Heidkamp")
+ (license "BSD")
+ (category db)
+ (dependencies matchable srfi-1 srfi-13)
+ (test-dependencies test)
+ (components (extension foops)
+             (extension ssql (component-dependencies foops))))

ssql.scm

@@ -3,11 +3,23 @@
 (ssql->sql ssql-connection scope-table find-tables ssql-compose
  register-sql-engine! define-operators *ansi-translator*)
 
-(import chicken scheme)
+(cond-expand
-(use matchable data-structures extras srfi-1 srfi-13 foops)
+  (chicken-4
-(import-for-syntax chicken)
+    (import chicken scheme)
-(begin-for-syntax
+    (use matchable data-structures extras srfi-1 srfi-13 foops)
- (use srfi-1 srfi-13))
+    (import-for-syntax chicken)
+    (begin-for-syntax
+     (use srfi-1 srfi-13)))
+  (chicken-5
+    (import-for-syntax srfi-1 srfi-13 (chicken string))
+    (import scheme
+            srfi-1
+            srfi-13
+            matchable
+            (chicken base)
+            (chicken format)
+            (chicken string)
+            foops)))
 
 (define (before? x y lst)
   (let loop ((lst lst))

tests/ansi-test.scm

@@ -1,4 +1,9 @@
-(use test)
+(cond-expand
+  (chicken-4
+    (use test))
+  (chicken-5
+    (import test)))
+
 (import ssql)
 
 (test-group "selects"
@@ -86,4 +91,4 @@
 
   (test "IS NOT NULL"
     "SELECT NOT 'foo' IS NULL"
-    (ssql->sql #f '(select (not (null? "foo"))))))
+    (ssql->sql #f '(select (not (null? "foo"))))))

tests/composition-test.scm

@@ -1,4 +1,9 @@
-(use test)
+(cond-expand
+  (chicken-4
+    (use test))
+  (chicken-5
+    (import test)))
+
 (import ssql)
 
 (test-group "composition"
@@ -11,4 +16,4 @@
   (test "merge"
     '(select (columns firstname lastname age) (from artists) (order firstname lastname))
     (ssql-compose #f '(select (columns firstname lastname) (order firstname))
-                  '((columns age) (from artists) (order lastname)))))
+                  '((columns age) (from artists) (order lastname)))))

tests/foops-test.scm

@@ -1,7 +1,11 @@
-(load-relative "../foops")
+(cond-expand
+  (chicken-4
+    (load-relative "../foops")
+    (use test))
+  (chicken-5
+    (import srfi-1 test foops)))
 
 (import foops)
-(use test)
 
 (test-group "basic functionality"
   (define foo (make-object () ((bar) 'baz)))
@@ -46,4 +50,4 @@
 
   (test 'wroom (vehicle 'drive))
   (test '(wroom wroom) (vehicle 'drive 2))
-  (test '(fast wroom wroom wroom) (vehicle 'drive 3 'fast)))
+  (test '(fast wroom wroom wroom) (vehicle 'drive 3 'fast)))

tests/run.scm

@@ -1,7 +1,18 @@
-(load-relative "foops-test")
+(cond-expand
-(load-relative "../ssql")
+  (chicken-4
-(load-relative "transformations-test")
+    (load-relative "foops-test")
-(load-relative "ansi-test")
+    (load-relative "../ssql")
-(load-relative "composition-test")
+    (load-relative "transformations-test")
+    (load-relative "ansi-test")
+    (load-relative "composition-test"))
+  (chicken-5
+    (import test (chicken platform))
+    (repository-path (cons ".." (repository-path)))
+    (load "foops-test")
+    (load "transformations-test")
+    (load "ansi-test")
+    (load "composition-test")))
+
+(test-exit)
+
 
-(test-exit)

tests/transformations-test.scm

@@ -1,4 +1,9 @@
-(use test)
+(cond-expand
+  (chicken-4
+    (use test))
+  (chicken-5
+    (import test)))
+
 (import ssql)
 
 (test-begin "inspection")
@@ -39,4 +44,4 @@
                                     (on (= roles.actor_id actors.id)))
                               movies
                               (on (= movies.id roles.movie_id)))))))
-(test-end "scoping")
+(test-end "scoping")