(module test-infix-stx mzscheme
(require "infix-stx.ss")
(define-syntax (assert-expected stx)
(syntax-case stx ()
[(_ x y ...)
(syntax/loc stx
(if (equal? x (infix y ...))
'ok
(error 'test "unexpected: ~a ~a" x (infix y ...))))]))
(define-syntax (assert-true original-stx)
(syntax-case original-stx ()
[(_ x)
(with-syntax ([stx original-stx])
(syntax/loc original-stx
(unless x
(error 'assert-true "failed at ~a" (quote stx)))))]))
(define-syntax (assert-false original-stx)
(syntax-case original-stx ()
[(_ x)
(with-syntax ([stx original-stx])
(syntax/loc original-stx
(when x
(error 'assert-true "failed at ~a" (quote stx)))))]))
(define (test-suite)
(assert-expected 11 (1 + 2 * 3 + 4))
(let ([square (lambda (x) (* x x))])
(assert-expected 81
square(9)))
(let ([f (lambda (x) (lambda (y) (+ x y)))])
(assert-expected 9
f(4)(5)))
(assert-true (infix 0 < 1))
(assert-false (infix 1 < 0))
(let ([between?
(lambda (a b c) (infix a <= b < c))])
(assert-true (between? 1 2 3))
(assert-true (between? 1 1 2))
(assert-false (between? 3 2 1))
(assert-false (between? 1 1 1)))
(let* [(count 0)
(f (lambda (x)
(set! count (add1 count))
x))]
(assert-expected #t f(1) <= f(2) < f(3))
(assert-true (= count 3)))
(let* [(count 0)
(f (lambda (x)
(set! count (add1 count))
x))]
(assert-expected #f f(2) <= f(1) < f(3))
(assert-true (= count 2))))
(test-suite))