(import test)

(import (only (chicken format) format))
(include "test-gloss.incl")

;;

(test-begin "More Macros")

(import moremacros)

;;

(cond-expand
  (compiling
    (test-group "Expansion Time Info"
      (let ((lno (__line__)))
        (glossf "(__date__): ~S" (__date__))
        (glossf "(__time__): ~S" (__time__))
        (glossf "(__file__): ~S" (__file__))
        (glossf "(__line__): ~S" lno)
        (test "(__file__)" "moremacros-test.scm" (__file__))
        (test "(__line__)" 17 lno) ) ) )
  (else) )

;;

(test-group "Either/Or"
  (test-assert (true #f))
  (test-assert (not (false #t)))
  (test-assert (true? #t))
  (test-assert (not (true? 1)))
  (test-assert (false? #f))
)

(test-group "switch"
  (test "switch" #t
    (switch '(foo)
      (("foo" 'foo)   'foo)
      (('(foo) 'foo)   #t)
      (else           #f)))
)

(test-group "swap!"
  (let ((a 1) (b 2))
    (test "swap! before" '(1 2) (list a b))
    (swap! a b)
    (test "swap! after" '(2 1) (list a b)) )
)

#;
(test-group "swap-set!, fluid-set!, stiff-set!"
  (let ((a 1) (b 2))
    (test "swap-set! before" '(1 2) (list a b))
    (swap-set! a b)
    (test "swap-set! after" '(2 1) (list a b)) )
  (let ((a 1) (b 2))
    (test "fluid-set! before" '(1 2) (list a b))
    (fluid-set! a 23 b (+ a b) (begin
      (test "fluid-set! during" '(23 25) (list a b))))
    (test "fluid-set! after" '(1 2) (list a b)) )
  (let ((a 1) (b 2))
    (test "stiff-set! before" '(1 2) (list a b))
    (stiff-set! a 23 b (+ a b))
    (test "stiff-set! after" '(23 25) (list a b)) )
)

(test-group "set!-op"
  (let ((a 1) (b 2))
    (set!-op a + 2 <> b)
    (test 5 a) )
)

(test-group "type-case"
  (test 'numeric
    (type-case 23
      ((symbol string char) 'symbolic)
      (number               'numeric)
      (else                 'otheric)))
  (test '(23 numeric)
    (type-case* 23
      ((symbol string char) (list it 'symbolic))
      (number               (list it 'numeric))
      (else                 (list it 'otheric))))
)

;;

(import numeric-macros)

(test-group "Numeric Macros"
  (let ((ia 1) (fa 1.0))
    (test 2 (fx++ ia))
    (test 0 (fx-- ia))
    (test 2.0 (fp++ fa))
    (test 0.0 (fp-- fa))
    (test 2.0 (fl++ fa))
    (test 0.0 (fl-- fa))
    (test 2 (1+ ia))
    (test 2 (++ ia))
    (test 2.0 (++ fa))
    (test 0 (1- ia))
    (test 0 (-- ia))
    (test 0.0 (-- fa)) )
  (let ((ia 1))
    (fx++! ia)
    (test 2 ia)
    (fx--! ia)
    (test 1 ia) )
  (let ((fa 1.0))
    (fp++! fa)
    (test 2.0 fa)
    (fp--! fa)
    (test 1.0 fa)
    (fl++! fa)
    (test 2.0 fa)
    (fl--! fa)
    (test 1.0 fa) )
  (let ((ia 1) (fa 1.0))
    (++! ia)
    (test 2 ia)
    (++! fa)
    (test 2.0 fa)
    (--! ia)
    (test 1 ia)
    (--! fa)
    (test 1.0 fa) )
  (test-assert (seven? 7))
  (test-assert (not (seven? 5)))
)

;;

(import hash-let srfi-69)

(test-group "Hash Let"
  (define tbl (make-hash-table))

  (hash-table-set! tbl 'abc "commercial network")
  (hash-table-set! tbl "abc" "commercial network")
  (hash-table-set! tbl 'cbs "commercial network")
  (hash-table-set! tbl "cbs" "commercial network")

  (hash-let tbl (
    (abc)
    (cbs "cbs")
    (pbs (string-append "p" "bs") #t)
    tbs )
    (test "commercial network" abc)
    (test "commercial network" cbs)
    (test #t pbs)
    (test #f tbs) )
)

;;

(test-end  "More Macros")

(test-exit)