(module test mzscheme

  (require "module-utils.ss"
           (planet "test.ss" ("schematics" "schemeunit.plt" 2))
           (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)))

  (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))))

  (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->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))))))

  )