(module test mzscheme

  (require "module-utils.ss"
           (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 3))
           (planet "test.ss" ("schematics" "schemeunit.plt" 2 9))
           (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2 9)))

  (define lc-path '(file "languages/lambda-calculus.ss"))
  (define htdp-path '(lib "htdp-beginner.ss" "lang"))

  (define-check (check-namespace ns)
    (unless (namespace? ns)
      (with-check-info*
       (list (make-check-message "not a namespace"))
       (fail-check)))
    (when (eq? (namespace-module-registry ns)
               (namespace-module-registry (current-namespace)))
      (with-check-info*
       (list (make-check-message "reused module registry"))
       (fail-check))))

  (define here (syntax-source-module-name #'here))

  (test/graphical-ui
   (test-suite "module-utils.ss"
     (test-suite "get-module"
       (test-case "htdp beginner"
         (check-pred module-handle? (get-module htdp-path)))
       (test-case "lambda calculus"
         (check-pred module-handle? (get-module lc-path))))
     (test-suite "module-path"
       (test-case "htdp beginner"
         (check-equal? (module-path (get-module htdp-path)) htdp-path))
       (test-case "lambda calculus"
         (check-equal? (module-path (get-module lc-path)) lc-path)))
     (test-suite "module-resolve"
       (test-case "htdp beginner"
         (check-pred symbol? (module-resolve (get-module htdp-path))))
       (test-case "lambda calculus"
         (check-pred symbol? (module-resolve (get-module lc-path)))))
     (test-suite "module-attach"
       (test-case "htdp beginner"
         (let* ([ns (make-namespace 'initial)]
                [mod (get-module htdp-path)])
           (check-not-exn (lambda () (module-attach mod ns)))
           (check-eq?
            (module-resolve mod)
            (parameterize ([current-namespace ns])
              ((current-module-name-resolver) htdp-path here #f #f)))))
       (test-case "lambda calculus"
         (let* ([ns (make-namespace 'empty)]
                [mod (get-module lc-path)])
           (check-not-exn (lambda () (module-attach mod ns)))
           (check-eq?
            (module-resolve mod)
            (parameterize ([current-namespace ns])
              ((current-module-name-resolver) lc-path here #f #f))))))
     (test-suite "module->external-namespace"
       (test-case "htdp beginner"
         (check-namespace (module->external-namespace (get-module htdp-path))))
       (test-case "lambda calculus"
         (check-namespace (module->external-namespace (get-module lc-path)))))
     (test-suite "module->internal-namespace"
       (test-case "htdp beginner"
         (check-namespace (module->internal-namespace (get-module htdp-path))))
       (test-case "lambda calculus"
         (check-namespace (module->internal-namespace (get-module lc-path)))))
     (test-suite "module-exported-names"
       (test-case "htdp beginner"
         (let* ([htdp-handle (get-module htdp-path)])
           (check-equal? (module-exported-names htdp-handle)
                         (namespace-mapped-symbols
                          (module->external-namespace htdp-handle)))))
       (test-case "lambda calculus"
         (let* ([lc-handle (get-module lc-path)])
           (check-equal? (module-exported-names lc-handle)
                         (namespace-mapped-symbols
                          (module->external-namespace lc-handle))))))
     (test-suite "module->eval"
       (test-case "htdp beginner"
         (check-equal?
          ((module->eval (get-module htdp-path))
           '(posn-x (make-posn 1 2)))
          1))
       (test-case "lambda calculus"
         (let* ([lc-handle (get-module lc-path)]
                [lc-eval (module->eval lc-handle)]
                [lc-id (lc-eval '((lambda (f)
                                    (lambda (v) ((f f) v)))
                                  (lambda (x) x)))]
                [unique (gensym 'unique)])
           (check-eq? (lc-id unique) unique))))
     (test-suite "eval-in/top-level"
       (test-case "htdp beginner"
         (check-equal?
          (eval-in/top-level (get-module htdp-path)
                             '[(+ 1 2)
                               (* 3 4)])
          12))
       (test-case "lambda calculus"
         (let* ([lc-id (eval-in/top-level (get-module lc-path)
                                          '[(lambda (x) x)])]
                [unique (gensym 'unique)])
           (check-eq? (lc-id unique) unique))))
     (test-suite "eval-in/module"
       (test-case "htdp beginner"
         (check-not-exn
          (lambda ()
            (eval-in/module (get-module htdp-path)
                            '[(define (plus x y) (+ x y))
                              (plus 1 2)]))))
       (test-case "lambda calculus"
         (check-not-exn
          (lambda ()
            (eval-in/module (get-module lc-path)
                            '[(lambda (x) x)])))))
     ))

  )