(module module-lang-test mzscheme
  (require "drscheme-test-util.ss"
           (lib "class.ss")
           (lib "file.ss")
           (lib "etc.ss")
           (lib "mred.ss" "mred")
           (lib "framework.ss" "framework")
           (prefix fw: (lib "framework.ss" "framework")))
  
  (provide run-test)
  
  (define-struct test (definitions   ;; string
                       interactions  ;; (union #f string)
                       result))      ;; string

  (define this-dir (collection-path "tests" "drscheme"))

  (define tests
    (list
     
     (make-test "" 
                #f
                (regexp "module-language: the definitions window must contain a module"))
     (make-test "1" 
                #f
                (regexp "module-language: only module expressions are allowed"))
     (make-test "(module m mzscheme) 1" 
                #f 
                (regexp "module-language: there can only be one expression in the definitions window"))
     (make-test "(module m mzscheme (provide x) (define x 1))" "x" "1")
     (make-test "(module m mzscheme (define x 1))" "x" "1")
     (make-test "(module m mzscheme (define x 1) (define y 1) (provide y))" "x" "1")
     (make-test "(module m mzscheme (define x 1) (define y 2) (provide y))" "y" "2")
     (make-test "(module m mzscheme (require (lib \"list.ss\")))" 
                "foldl" 
                (regexp "foldl"))
     
     (make-test "(module m mzscheme (require (rename (lib \"list.ss\") local-foldl foldl)))" 
                "local-foldl"
                (regexp "foldl>"))
     
     (make-test "(module m mzscheme (require (all-except (lib \"list.ss\") foldl)))" 
                "first"
                (regexp "first>"))
     (make-test "(module m mzscheme (require (all-except (lib \"list.ss\") foldl)))" 
                "foldl"
                ". reference to an identifier before its definition: foldl")
     
     (make-test "(module m mzscheme (require (prefix mz: mzscheme)))" "mz:+" #rx"primitive:+")
     
     (make-test "(module n mzscheme (provide (all-from-except mzscheme +)))"
                "+"
                #rx"primitive:+")
     
     (make-test "(module m mzscheme (require (prefix x: (lib \"list.ss\")) (lib \"list.ss\")))" 
                "foldl"
                (regexp "foldl>"))
     (make-test "(module m mzscheme (require (prefix x: (lib \"list.ss\")) (lib \"list.ss\")))" 
                "x:foldl"
                (regexp "foldl>"))
     
     (make-test (format "~s"
                        `(module m (file ,(path->string (build-path this-dir "module-lang-test-tmp.ss")))
                           x))
                "x"
                "1")
     
     ;; + shouldn't be bound in the REPL because it isn't bound
     ;; in the module.
     (make-test (format "~s"
                        `(module m (file ,(path->string (build-path this-dir "module-lang-test-tmp.ss")))
                           x))
                "+"
                ". reference to an identifier before its definition: +")
     
     (make-test (format "~s" '(module m mzscheme (provide lambda)))
                "(lambda (x) x)"
                #rx"<procedure")
     
     (make-test (format "~s" '(module m mzscheme (define-syntax (m x) (syntax 1)) (provide m)))
                "(m)"
                "1")
     (make-test (format "~s" '(module m mzscheme (define-syntax s (syntax 1)) (provide s)))
                "s"
                "s: illegal use of syntax in: s")
     
     (make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define a 10)) x x))
                "a"
                ". reference to an identifier before its definition: a")
     (make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define-syntax (a stx) #'10)) x x))
                "a"
                ". reference to an identifier before its definition: a")
     (make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define a 10)) x x (define a 77)))
                "a"
                "77")
     (make-test (format "~s" '(module m mzscheme (define-syntax (x stx) #'(define-syntax (a stx) #'10)) x x (define a 78)))
                "a"
                "78")
     
     (make-test
      (format "~s" `(module m mzscheme
                      (require-for-syntax (file ,(path->string (build-path this-dir "module-lang-test-tmp2.ss"))))
                      (provide s)
                      (define-syntax (s stx) e)))
      (format "~s ~s" '(require m) 's)
      ". module-lang-test-tmp2.ss:1:70: compile: bad syntax; literal data is not allowed, because no #%datum syntax transformer is bound in: 1")))
  
  ;; set up for tests that need external files
  (call-with-output-file (build-path this-dir "module-lang-test-tmp.ss")
    (lambda (port)
      (write `(module module-lang-test-tmp mzscheme
                (provide (all-from-except mzscheme +)
                         x)
                (define x 1))
             port))
    'truncate
    'text)
  
  (call-with-output-file (build-path this-dir "module-lang-test-tmp2.ss")
    (lambda (port)
      (write `(module module-lang-test-tmp2 mzscheme
                (provide e)
                (define e #'1))
             port))
    'truncate
    'text)

  (define drs (wait-for-drscheme-frame))
  (define interactions-text (send drs get-interactions-text))
  
  (define (single-test test)
    (let/ec k
      (clear-definitions drs)
      (type-in-definitions drs (test-definitions test))
      (do-execute drs)
        
      (let ([ints (test-interactions test)])
        
        (when ints
          (let ([after-execute-output
                 (send interactions-text
                       get-text
                       (send interactions-text paragraph-start-position 2)
                       (send interactions-text paragraph-end-position 2))])
            (unless (string=? "> " after-execute-output)
              (printf "FAILED: ~a\n        ~a\n        expected no output after execution, got: ~s\n"
                      (test-definitions test)
                      (or (test-interactions test) 'no-interactions)
                      after-execute-output)
              (k (void)))
            (type-in-interactions drs ints)
            (fw:test:keystroke #\return)
            (wait-for-computation drs)))
        
        (let* ([para-to-check (- (send interactions-text position-paragraph
                                       (send interactions-text last-position))
                                 1)]
               [after-int-start
                (send interactions-text paragraph-start-position para-to-check)]
               [after-int-end
                (send interactions-text paragraph-end-position para-to-check)]
               [after-int-output (send interactions-text
                                       get-text
                                       after-int-start
                                       after-int-end)]
               [passed?
                (cond
                  [(string? (test-result test))
                   (string=? after-int-output (test-result test))]
                  [(regexp? (test-result test))
                   (regexp-match (test-result test) after-int-output)])])
          (unless passed?
            (printf "FAILED: ~a\n        ~a\n  expected: ~a\n       got: ~a\n"
                    (test-definitions test)
                    (or (test-interactions test) 'no-interactions)
                    (test-result test)
                    after-int-output))))))
  
  (define (run-test)
    (set-language-level! '("(module ...)") #t)
    (for-each single-test tests)))