(module test-language mzscheme

  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
           "../language/acl2-module-v.scm")

  (provide test-language)

  (define test-namespace (make-namespace 'initial))

  (define-syntax (test-eval-ok stx)
    (syntax-case stx ()
      [(t-e-ok name body ...)
       (identifier? #'name)
       (syntax/loc stx
         (test-case (symbol->string 'name)
           (check-not-exn
            (lambda ()
              (parameterize ([current-namespace test-namespace])
                (eval `(module name mzscheme body ...))
                (eval `(require name)))))))]))

  (define-syntax (test-eval-bad stx)
    (syntax-case stx ()
      [(t-e-bad name proc body ...)
       (identifier? #'name)
       (syntax/loc stx
         (test-case (symbol->string 'name)
           (check-exn
            proc
            (lambda ()
              (parameterize ([current-namespace test-namespace])
                (eval `(module name mzscheme body ...))
                (eval `(require name)))))))]))

  (define test-language
    (test-suite "Language"
      (test-suite "defun"
        (test-eval-ok
         two-defuns
         (require (planet "language/defun.scm" ,planet-loc))
         (defun f (x) (+ x 1))
         (f 3)
         (defun g (x) (f (f x)))
         (g 4))
        (test-eval-bad
         mutually-recursive-defuns
         exn:fail:syntax?
         (require (planet "language/defun.scm" ,planet-loc))
         (defun evenp (x)
           (if (zero? x) #t (oddp (- x 1))))
         (defun oddp (x)
           (if (zero? x) #f (evenp (- x 1))))))
      (test-suite "defstub"
        (test-eval-ok
         stub-and-defun
         exn:fail:user?
         (require (planet "language/defun.scm" ,planet-loc))
         (defstub s (a b) t)
         (defun f (x y) (s x y)))
        (test-eval-bad
         stub-called
         exn:fail:user?
         (require (planet "language/defun.scm" ,planet-loc))
         (defstub s () t)
         (s)))
      (test-suite "mutual-recursion"
        (test-eval-ok
         two-functions
         (require (planet "language/defun.scm" ,planet-loc))
         (mutual-recursion
          (defun evenp (x)
            (if (zero? x) #t (oddp (- x 1))))
          (defun oddp (x)
            (if (zero? x) #f (evenp (- x 1)))))
         (evenp 4))
        (test-eval-bad
         arity-error
         exn:fail:syntax?
         (require (planet "language/defun.scm" ,planet-loc))
         (mutual-recursion
          (defun f1 (x) (f2 x 0))
          (defun f2 (x y) (f1 x y)))))
      (test-suite "defconst"
        (test-eval-ok
         defconst-five
         (require (planet "language/defconst.scm" ,planet-loc))
         (defconst *five* 5))
        (test-eval-bad
         defconst-bad-name
         exn:fail:syntax?
         (require (planet "language/defconst.scm" ,planet-loc))
         (defconst five 5)))
      (test-suite "app"
        (test-eval-ok
         app-+
         exn:fail:syntax?
         (require (planet "language/acl2-app.scm" ,planet-loc))
         (acl2-app + 1 2))
        (test-eval-bad
         app-higher-order
         exn:fail:syntax?
         (require (planet "language/acl2-app.scm" ,planet-loc))
         (acl2-app (acl2-app current-eval) '(+ 1 2))))
      (test-suite "defstructure"
        (test-eval-ok
         defstructure-point
         (require (planet "language/defstructure.scm" ,planet-loc))
         (defstructure point x y)
         (point-x (point 1 2))
         (point-y (point 2 3))
         (point-p (point 3 4))
         (weak-point-p (point 4 5)))
        (test-eval-bad
         defstructure-forward-ref
         exn:fail:syntax?
         (require (planet "language/defstructure.scm" ,planet-loc))
         (point 1 2)
         (defstructure point x y)))))

  )