HomeAboutCodePastes
summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordieggsy <dieggsy@protonmail.com>2019-10-30 22:18:04 -0400
committerdieggsy <dieggsy@protonmail.com>2019-10-30 22:18:32 -0400
commit8ebdd13f00a587cc6c0b218f65abf0345f397e7c (patch)
treed69aff2c19cc069b443d0efc725a8edf74114b7f
parent2f7c4886f0a1fdc2b5fae285256949333b768067 (diff)
downloadsrfi-105-8ebdd13f00a587cc6c0b218f65abf0345f397e7c.tar.gz
Clarify tests, properly exit0.1.7
-rw-r--r--srfi-105.release-info1
-rw-r--r--tests/run.scm111
2 files changed, 63 insertions, 49 deletions
diff --git a/srfi-105.release-info b/srfi-105.release-info
index 3f4af49..1af5566 100644
--- a/srfi-105.release-info
+++ b/srfi-105.release-info
@@ -5,4 +5,5 @@
(release "0.1.4")
(release "0.1.5")
(release "0.1.6")
+(release "0.1.7")
diff --git a/tests/run.scm b/tests/run.scm
index 4e928df..8cade65 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -1,57 +1,70 @@
(import srfi-105
+ chicken.port
+ chicken.string
test)
(test-begin "srfi-105")
+(define (test-example str #!optional fail)
+ (let* ((parts (string-split str "⇏⇒"))
+ (curly (with-input-from-string (car parts) read))
+ (expansion (with-input-from-string (cadr parts) read)))
+ (if fail
+ (test-assert str (not (equal? expansion curly)))
+ (test str expansion curly))))
+
(test-group "srfi-105 document examples"
- (test '(<= n 5) (expand '{n <= 5}))
- (test '(+ x 1) (expand '{x + 1}))
- (test '(+ a b c) (expand '{a + b + c}))
- (test '(,op x y z) (expand '{x ,op y ,op z}))
- (test '(eqv? x `a) (expand '{x eqv? `a}))
- (test '(eq? 'a b) (expand '{'a eq? b}))
- (test '(+ n-1 n-2) (expand '{n-1 + n-2}))
- (test '(* a (+ b c)) (expand '{a * {b + c}}))
- (test '(+ a (- b c)) (expand '{a + {b - c}}))
- (test '(- (+ a b) c) (expand '{{a + b} - c}))
- ;; ;; This one's close enough
- ;; (test (expand '{{a > 0} and {b >= 1}}) '(and (> a 0) (>= b 1)))
- (test '() (expand '{}))
- (test '5 (expand '{5}))
- (test '(- x) (expand '{- x}))
- (test '(>= (length x) 6) (expand '{length(x) >= 6}))
- (test '(+ (f x) (g y) (h z)) (expand '{f(x) + g(y) + h(z)}))
- (test '(+ (f a b) (g h)) (expand '{(f a b) + (g h)}))
- (test '(+ (f a b) (g h)) (expand '{f(a b) + g(h)}))
- (test '(+ a (f b) x) (expand '{a + f(b) + x}))
- (test '(/ (- a) b) (expand '{(- a) / b}))
- (test '(/ (- a) b) (expand '{-(a) / b}))
- (test '(cos q) (expand '{cos(q)}))
- (test '(e) (expand '{e{}}))
- (test '(e) (expand '{e{ }}))
- (test '(pi) (expand '{pi()}))
- (test '(f x) (expand {'f(x)}))
- ;; ;; No support for this in chicken
- ;; (test (expand '{#1=f(#1#)}) '#1=(f #1#))
- (test '(f (g (h x))) (expand '{ (f (g h(x))) }))
- (test '#(1 2 (f a) 4) (expand '{#(1 2 f(a) 4)}))
- (test '(f (h x)) (expand '{(f #;g(x) h(x))}))
- (test '(map - ns) (expand '{(map - ns)}))
- (test '(map - ns) (expand '{map(- ns)}))
- (test '(* n (factorial (- n 1))) (expand '{n * factorial{n - 1}}))
- (test '(* 2 (sin (- x))) (expand '{2 * sin{- x}}))
- (test '($nfx$ 3 + 4 +) (expand '{3 + 4 +}))
- (test '($nfx$ 3 + 4 + 5 +) (expand '{3 + 4 + 5 +}))
- ;; ;; Not supported in chicken scheme
- ;; (test (expand '{a . z}) '($nfx$ a . z))
- (test (expand '{a + b - c}) '($nfx$ a + b - c))
- ;; ;; Not supported in chicken scheme
- ;; (test (expand '{read(. options)}) '(read . options))
- (test '((a x) y) (expand '{a(x)(y)}))
- (test '($bracket-apply$ x a) (expand '{x[a]}))
- (test '($bracket-apply$ y a b) (expand '{y[a b]}))
- (test '((f (- n 1)) x) (expand '{f{n - 1}(x)}))
- (test '((f (- n 1)) (- y 1)) (expand '{f{n - 1}{y - 1}}))
- (test '($bracket-apply$ (f (- x)) y) (expand '{f{- x}[y]})))
+ (test-example "{n <= 5} ⇒ (<= n 5)")
+ (test-example "{x + 1} ⇒ (+ x 1)")
+ (test-example "{a + b + c} ⇒ (+ a b c)")
+ (test-example "{x ,op y ,op z} ⇒ (,op x y z)")
+ (test-example "{x eqv? `a} ⇒ (eqv? x `a)")
+ (test-example "{'a eq? b} ⇒ (eq? 'a b)")
+ (test-example "{n-1 + n-2} ⇒ (+ n-1 n-2)")
+ (test-example "{a * {b + c}} ⇒ (* a (+ b c))")
+ (test-example "{a + {b - c}} ⇒ (+ a (- b c))")
+ (test-example "{{a + b} - c} ⇒ (- (+ a b) c)")
+ (test-example "{{a > 0} and {b >= 1}} ⇒ (and (> a 0) (>= b 1))")
+ (test-example "{} ⇒ ()")
+ (test-example "{5} ⇒ 5")
+ (test-example "{- x} ⇒ (- x)")
+ (test-example "{length(x) >= 6} ⇒ (>= (length x) 6)")
+ (test-example "{f(x) + g(y) + h(z)} ⇒ (+ (f x) (g y) (h z))")
+ (test-example "{(f a b) + (g h)} ⇒ (+ (f a b) (g h))")
+ (test-example "{f(a b) + g(h)} ⇒ (+ (f a b) (g h))")
+ (test-example "'{a + f(b) + x} ⇒ '(+ a (f b) x)")
+ (test-example "{(- a) / b} ⇒ (/ (- a) b)")
+ (test-example "{-(a) / b} ⇒ (/ (- a) b)")
+ (test-example "{cos(q)} ⇒ (cos q)")
+ (test-example "{e{}} ⇒ (e)")
+ (test-example "{pi()} ⇒ (pi)")
+ (test-example "{'f(x)} ⇒ '(f x)")
+ ;; (test-example "{#1=f(#1#)} ⇒ #1=(f #1#)")
+ (test-group "Deviations from specification (expansions fail)"
+ (test-example "{ (f (g h(x))) } ⇏ (f (g (h x)))" 'fail)
+ (test-example "{#(1 2 f(a) 4)} ⇏ #(1 2 (f a) 4)" 'fail)
+ (test-example "{(f #;g(x) h(x))} ⇏ (f (h x))" 'fail))
+ (test-group "Workarounds to deviations from specification"
+ (test-example "{ (f (g {h(x)})) } ⇒ (f (g (h x)))")
+ (test-example "{#(1 2 {f(a)} 4)} ⇒ #(1 2 (f a) 4)")
+ (test-assert "NO WORKAROUND: {(f #;g(x) h(x))} ⇏ (f (h x))" #t))
+ (test-group "Unsupported syntax (expansions error)"
+ (test-assert "UNSUPPORTED: {#1=f(#1#)} ⇏ #1=(f #1#)" #t)
+ (test-assert "UNSUPPORTED: {a . z} ⇏ ($nfx$ a . z)" #t)
+ (test-assert "UNSUPPORTED: {read(. options)} ⇏ (read . options)" #t))
+ (test-example "{(map - ns)} ⇒ (map - ns)")
+ (test-example "{map(- ns)} ⇒ (map - ns)")
+ (test-example "{n * factorial{n - 1}} ⇒ (* n (factorial (- n 1)))")
+ (test-example "{2 * sin{- x}} ⇒ (* 2 (sin (- x)))")
+ (test-example "{3 + 4 +} ⇒ ($nfx$ 3 + 4 +)")
+ (test-example "{3 + 4 + 5 +} ⇒ ($nfx$ 3 + 4 + 5 +)")
+ (test-example "{a + b - c} ⇒ ($nfx$ a + b - c)")
+ (test-example "{a(x)(y)} ⇒ ((a x) y)")
+ (test-example "{x[a]} ⇒ ($bracket-apply$ x a)")
+ (test-example "{y[a b]} ⇒ ($bracket-apply$ y a b)")
+ (test-example "{f{n - 1}(x)} ⇒ ((f (- n 1)) x)")
+ (test-example "{f{n - 1}{y - 1}} ⇒ ((f (- n 1)) (- y 1))")
+ (test-example "{f{- x}[y]} ⇒ ($bracket-apply$ (f (- x)) y)"))
(test-end "srfi-105")
+(test-exit)