~dieggsy/srfi-105

8ebdd13f00a587cc6c0b218f65abf0345f397e7c — dieggsy 3 years ago 2f7c488 0.1.7
Clarify tests, properly exit
2 files changed, 63 insertions(+), 49 deletions(-)

M srfi-105.release-info
M tests/run.scm
M srfi-105.release-info => srfi-105.release-info +1 -0
@@ 5,4 5,5 @@
(release "0.1.4")
(release "0.1.5")
(release "0.1.6")
(release "0.1.7")


M tests/run.scm => tests/run.scm +62 -49
@@ 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)