(module test mzscheme

  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 10))
           (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2 10))
           (planet "module-utils.ss" ("cce" "module-utils.plt" 1 0))
           (lib "etc.ss"))

  (provide test-define-below)

  (define define-below-path
    (build-path (this-expression-source-directory) "define-below.ss"))
  (define define-below-spec
    `(file ,(path->string define-below-path)))
  (define define-below-require
    `(require ,define-below-spec))

  (define mzscheme-module (get-module 'mzscheme))

  (define (eval/module code)
    ((module->eval mzscheme-module)
     `(module temp mzscheme ,define-below-require ,@code)))

  (define (eval/internal code)
    (eval/module `[(let () ,@code (void))]))

  (define (sexps->string first . rest)
    (apply format
           (apply string-append "~s" (map (lambda args "\n~s") rest))
           first rest))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; Note: not testing the top-level,
  ;; which generates no or runtime error
  ;; rather than syntax error for
  ;; unbound names.
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (define-syntax (test-eval/success stx)
    (syntax-case stx ()
      [(te/s code)
       (syntax/loc stx
         (let ([c code])
           (test-suite (apply sexps->string c)
             (test-not-exn "module" (lambda () (eval/module c)))
             (test-not-exn "internal" (lambda () (eval/internal c))))))]))

  (define-syntax (test-eval/failure stx)
    (syntax-case stx ()
      [(te/f pred code)
       (syntax/loc stx
         (let ([c code]
               [p pred])
           (test-suite (apply sexps->string c)
             (test-exn "module" p (lambda () (eval/module c)))
             (test-exn "internal" p (lambda () (eval/internal c))))))]))

  (define test-define-below
    (test-suite "define-below"
      (test-eval/success
       '[(define-below (f x) (+ 1 x))
         (define-below (g x) (+ 1 (f x)))
         (list (f 1) (g 1))])
      (test-eval/success
       '[(define-values-below (evenp oddp)
           (values (lambda (x) (if (zero? x) #t (oddp (- x 1))))
                   (lambda (x) (if (zero? x) #f (evenp (- x 1))))))
         (list (evenp 4) (oddp 4))])
      (test-eval/failure
       exn:fail:syntax?
       '[(define-below (j x) (+ 1 (h x)))
         (define-below (h x) (+ 1 x))])
      (test-eval/failure
       exn:fail:syntax?
       '[(k 1)
         (define-below k (lambda (x) (+ 1 x)))])))

  )