add a bunch of tests to the module language test suite based on test cases in the repl test suite

(since the repl test suite tests the pretty big language's repl and since there was a test case
there that would have discovered a bug that we only found in the hours before the release but had
been lurking for a few days)

collects/tests/drracket/module-lang-test.rkt

@@ -1,5 +1,5 @@
 #lang at-exp racket/gui
-(require "module-lang-test-utils.rkt")
+(require "private/module-lang-test-utils.rkt")
 (provide run-test)
 
 ;; set up for tests that need external files
@@ -164,8 +164,7 @@
 
 (test @t{#lang racket}
       @t{(begin-for-syntax (+ 1 2))}
-      @t{> (begin-for-syntax (+ 1 2))}
+      @t{})
-      #t)
 
 (test @t{#lang racket}
       @t{(begin (struct s (x)) (struct t s (y)) (s-x (t 1 2)))}
@@ -255,6 +254,112 @@
                      "  (f)")
       #t)
 
+(test @t{#lang racket/base}
+      @t{(begin (values) 1)}
+      "1")
+
+(test @t{#lang racket/base}
+      @t{    (eval '(values 1 2))}
+      @t{1@"\n"2})
+(test @t{#lang racket/base}
+      @t{    (eval '(list 1 2))}
+      @t{'(1 2)})
+(test @t{#lang racket/base}
+      @t{    (eval '(lambda ()))}
+      @t{lambda: bad syntax in: (lambda ())})
+(test @t{#lang racket/base}
+      @t{(expt 3 (void))}
+      @rx{expt: expected argument of type <number>; given #<void>})
+(test @t{#lang racket/base}
+      @t{1 2 ( 3 4}
+      @t{1@"\n"2@"\n". read: expected a `)' to close `('})
+(test @t{#lang racket/base}
+      "1 2 . 3 4"
+      "1\n2\n. read: illegal use of \".\"")
+(test @t{#lang racket/base}
+      "1 2 (lambda ()) 3 4"
+      "1\n2\n. lambda: bad syntax in: (lambda ())")
+(test @t{#lang racket/base}
+      "1 2 x 3 4"
+      "1\n2\n. . reference to an identifier before its definition: x")
+(test @t{#lang racket/base}
+      "1 2 (raise 1) 3 4"
+      "1\n2\nuncaught exception: 1")
+(test @t{#lang racket/base}
+      "1 2 (raise #f) 3 4"
+      "1\n2\nuncaught exception: #f")
+(test @t{#lang racket/base}
+      "(current-namespace (make-empty-namespace)) if"
+      ". compile: unbound identifier (and no #%app syntax transformer is bound) in: #%top-interaction")
+(test @t{#lang racket/base}
+      (string-append
+       "(let ([old (error-escape-handler)])\n"
+       "(+ (let/ec k\n(dynamic-wind\n"
+       "(lambda () (error-escape-handler (lambda () (k 5))))\n"
+       "(lambda () (expt 3 #f))\n"
+       "(lambda () (error-escape-handler old))))\n"
+       "10))")
+      ". . expt: expected argument of type <number>; given #f\n15")
+(test @t{#lang racket/base}
+      "(write (list (syntax x)))"
+      "(.)")
+(test @t{#lang racket/base}
+      "(parameterize ([current-output-port (open-output-string)]) (write #'1))"
+      "")
+(test @t{#lang racket/base}
+      "(write-special 1)"
+      "1#t")
+(test @t{#lang racket/gui}
+      (format "~s ~s ~s"
+              '(define s (make-semaphore 0))
+              '(queue-callback
+                (lambda ()
+                  (dynamic-wind
+                   void
+                   (lambda () (expt 3 #f))
+                   (lambda () (semaphore-post s)))))
+              '(begin (yield s) (void)))
+      ". . expt: expected argument of type <number>; given #f")
+(test @t{#lang racket/base}
+      (format "~s ~s" 
+              '(define x 1) 
+              '((λ (x y) y) (set! x (call/cc (lambda (x) x))) (x 3)))
+      ". . procedure application: expected procedure, given: 3; arguments were: 3")
+(test @t{#lang racket/base}
+      (format "~s ~s ~s ~s"
+              '(begin (define k (call/cc (λ (x) x)))
+                      (define x 'wrong))
+              '(set! x 'right)
+              '(k 1)
+              'x)
+      "'right")
+(test @t{#lang racket/base}
+      (format "~s"
+              '(call-with-continuation-prompt
+                (lambda ()
+                  (eval '(begin (abort-current-continuation
+                                 (default-continuation-prompt-tag)
+                                 1 2 3)
+                                10)))
+                (default-continuation-prompt-tag)
+                list))
+      "'(1 2 3)")
+(test @t{#lang racket/gui}
+      "(vector (new snip%))"
+      "(vector .)")
+(test @t{#lang racket/base}
+      "(begin (thread (lambda () x)) (sleep 1/10))"
+      ". . reference to an identifier before its definition: x")
+(test @t{#lang racket/base}
+      "(require texpict/utils)(disk 3)"
+      ".")
+(test @t{#lang racket/base}
+      (string-append
+       "(require mzlib/pretty)"
+       "(pretty-print-print-hook (lambda x (expt 3 #f)))"
+       "(list 1 2 3)")
+      "'(1 2 3)")
+
 ;; test protection against user-code changing the namespace
 (test @t{#lang racket/base
          (current-namespace (make-base-namespace))}

collects/tests/drracket/private/module-lang-test-utils.rkt

@@ -1,5 +1,8 @@
-#lang scheme/gui
+#lang racket/gui
-(require "private/drracket-test-util.rkt" mzlib/etc framework scheme/string)
+(require "drracket-test-util.rkt"
+         mzlib/etc
+         framework
+         racket/string)
 
 (provide test t rx run-test in-here write-test-modules)
 
@@ -66,7 +69,9 @@
     (insert-in-definitions drs (test-definitions test))
     (do-execute drs)
     
-    (let ([ints (test-interactions test)])
+    (define ints (test-interactions test))
+    
+    (define output-start-paragraph 2)
     
     (when ints
       (let ([after-execute-output
@@ -85,32 +90,37 @@
                    after-execute-output)
           (k (void)))
         (type-in-interactions drs ints)
-          (test:keystroke #\return)
+        ;; set to be the paragraph right after the insertion.
+        (set! output-start-paragraph
+              (queue-callback/res
+               (λ () (+ (send interactions-text position-paragraph 
+                              (send interactions-text last-position))
+                        1))))
+        (test:keystroke #\return '(alt))
         (wait-for-computation drs)))
     
-      (let* ([text
+    (define text
       (queue-callback/res
        (λ ()
-                 (if (test-all? test)
+         (define para-before-prompt
-                     (let* ([para (- (send interactions-text position-paragraph
+           (- (send interactions-text position-paragraph
                     (send interactions-text last-position))
-                                     1)])
+              1))
+         (if (test-all? test)
              (send interactions-text
                    get-text
                    (send interactions-text paragraph-start-position 2)
-                             (send interactions-text paragraph-end-position para)))
+                   (send interactions-text paragraph-end-position para-before-prompt))
-                     (let* ([para (- (send interactions-text position-paragraph
-                                           (send interactions-text last-position))
-                                     1)])
              (send interactions-text
                    get-text
-                             (send interactions-text paragraph-start-position para)
+                   (send interactions-text paragraph-start-position output-start-paragraph)
-                             (send interactions-text paragraph-end-position para))))))]
+                   (send interactions-text paragraph-end-position para-before-prompt))))))
-             [output-passed? (let ([r (test-result test)])
+    (define output-passed?
+      (let ([r (test-result test)])
         ((cond [(string? r) string=?]
                [(regexp? r) regexp-match?]
                [else 'module-lang-test "bad test value: ~e" r])
-                                r text))])
+         r text)))
     (unless output-passed?
       (fprintf (current-error-port)
                "FAILED (line ~a): ~a\n        ~a\n  expected: ~s\n       got: ~s\n"
@@ -131,7 +141,7 @@
                     (test-line test)
                     (test-definitions test)
                     error-ranges-expected
-                        (send interactions-text get-error-ranges))))])))))
+                    (send interactions-text get-error-ranges))))])))
 
 (define drs 'not-yet-drs-frame)
 (define interactions-text 'not-yet-interactions-text)