blob: 463364ae29cdae9b717d78ced10238f46bf192b6 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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))))))))
|
