add hack to support foment and CHICKEN 5.3.0

1 files changed, 39 insertions, 0 deletions

diff --git a/lib/cuprate.simple-define-test-application.scm b/lib/cuprate.simple-define-test-application.scm
new file mode 100644
index 0000000..463364a
--- /dev/null
+++ b/lib/cuprate.simple-define-test-application.scm
@@ -0,0 +1,39 @@
+;;; Some buggy implementations do not rename temporaries on the left
+;;; hand side of a syntax-rules application. This is for implementations
+;;; that cannot work around this issue with a low-level mcaro system.
+;;; 
+;;; This shim is used to support the essential cases. This can be extended
+;;; to support more cases as desired.
+
+(define-syntax define-test-application
+  (syntax-rules ()
+    ((_ name ((predicate) value))
+     (define-syntax name
+       (syntax-rules ()
+         ((_ tmp) (name #f tmp))
+         ((_ test-name tmp)
+          (test-named-application test-name (#f predicate) (value tmp))))))
+    ((_ name (predicate value))
+     (define-syntax name
+       (syntax-rules ()
+         ((_ tmp1 tmp2) (name #f tmp1 tmp2))
+         ((_ test-name tmp1 tmp2)
+          (test-named-application test-name (predicate tmp1) (value tmp2))))))
+    ((_ name ((predicate) expected actual))
+     (define-syntax name
+       (syntax-rules ()
+         ((_ tmp1 tmp2) (name #f tmp1 tmp2))
+         ((_ test-name tmp1 tmp2)
+          (test-named-application test-name (#f predicate) (expected tmp1) (actual tmp2))))))
+    ((_ name (predicate expected actual))
+     (define-syntax name
+       (syntax-rules ()
+         ((_ tmp0 tmp1 tmp2) (name #f tmp0 tmp1 tmp2))
+         ((_ test-name tmp0 tmp1 tmp2)
+          (test-named-application test-name (predicate tmp0) (expected tmp1) (actual tmp2))))))
+    ((_ name ((predicate) a1 a2 a3))
+     (define-syntax name
+       (syntax-rules ()
+         ((_ t1 t2 t3) (name #f t1 t2 t3))
+         ((_ test-name t1 t2 t3)
+          (test-named-application test-name (#f predicate) (a1 t1) (a2 t2) (a3 t3))))))))
\ No newline at end of file