From 0375cc82ab4e08928c60049a6badea61f5ee9187 Mon Sep 17 00:00:00 2001
From: shuhung <shhyou@users.noreply.github.com>
Date: Mon, 11 Nov 2024 12:15:20 -0600
Subject: [PATCH] Adds some tests for racket/htdp#228, racket/htdp#229 and
 racket/htdp#230 (#689)

* Add some tests for racket/htdp#228, racket/htdp#229, and racket/htdp#230 to
  `tests/drracket/module-lang-test`.

  + Tests of racket/htdp#229 should first save the buffer to disk before running
  + Some racket/htdp#229 tests are ported from htdp-test:intm-lam.rktl

* Update `tests/drracket/language-test` to match racket/htdp#229.

* Manually check for empty stderr in tests/drracket/module-lang-test

  Somehow `-e`/`--check-stderr` does not work with `tests/drracket/module-lang-test`
  (perhaps due to using `test-log` + `exit 0` in `fire-up-drracket-and-run-tests`?)

* Test utils: sleep for 0.1s after printing error msg

  In tests/drracket/module-lang-test, stderr goes through a pipe to be
  checked for the absence of error messages. Therefore, sleep for 0.1s
  before existing to let the background thread pipe the messages to terminal.
---
 .../tests/drracket/language-test.rkt          |   8 +-
 .../tests/drracket/module-lang-test.rkt       | 511 +++++++++++++++++-
 .../drracket/private/drracket-test-util.rkt   |   1 +
 .../private/module-lang-test-utils.rkt        |  47 +-
 4 files changed, 551 insertions(+), 16 deletions(-)

diff --git a/drracket-test/tests/drracket/language-test.rkt b/drracket-test/tests/drracket/language-test.rkt
index 669841c49..dcb74eaef 100644
--- a/drracket-test/tests/drracket/language-test.rkt
+++ b/drracket-test/tests/drracket/language-test.rkt
@@ -1326,8 +1326,8 @@ the settings above should match r5rs
     (test-undefined-fn "(print (floor (sqrt 2)))" "print")
     
     (test-expression "(let ([f (lambda (x) x)]) f)" 
-                     "(lambda (a1) ...)"
-                     "(lambda (a1) ...)")
+                     "f"
+                     "f")
     (test-expression ",1"
                        "unquote: misuse of a comma or unquote, not under a quasiquoting backquote")
     
@@ -1503,8 +1503,8 @@ the settings above should match r5rs
     (test-expression "(print (floor (sqrt 2)))" "#i1.0")
     
     (test-expression "(let ([f (lambda (x) x)]) f)" 
-                     "(lambda (a1) ...)"
-                     "(lambda (a1) ...)")
+                     "f"
+                     "f")
     (test-expression ",1"
                      "unquote: misuse of a comma or unquote, not under a quasiquoting backquote")
     
diff --git a/drracket-test/tests/drracket/module-lang-test.rkt b/drracket-test/tests/drracket/module-lang-test.rkt
index b0f095db3..9584421fe 100644
--- a/drracket-test/tests/drracket/module-lang-test.rkt
+++ b/drracket-test/tests/drracket/module-lang-test.rkt
@@ -2,6 +2,9 @@
 (require "private/module-lang-test-utils.rkt"
          "private/drracket-test-util.rkt"
          framework
+         (only-in racket/gui/base sleep/yield)
+         drracket/private/stack-checkpoint
+         racket/list
          racket/class)
 (provide run-test)
 
@@ -527,13 +530,517 @@ f: contract violation
 }
       )
 
+(test @t{
+ #lang htdp/isl+
+
+ (check-expect (+ 123 45 6) even?)
+
+}
+      #f
+      #rx"check-expect.*function"
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? #rx"unsaved-editor:3:0"
+                              (srcloc->string loc)))
+             ;; ^ check-expect is in the backtrace, not some internal test-engine modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]check-expect.*[?][)]"
+                                      (test-definitions test)))
+             ;; ^ check-expect is highlighted
+             )))
+
+(test @t{
+ #lang htdp/isl+
+
+ (check-expect (sqrt 2) (sqrt 2))
+
+}
+      #f
+      #rx"check-expect.*inexact"
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? #rx"unsaved-editor:3:0"
+                              (srcloc->string loc)))
+             ;; ^ check-expect is in the backtrace, not some internal test-engine modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]check-expect.*sqrt 2[)][)]"
+                                      (test-definitions test)))
+             ;; ^ check-expect is highlighted
+             )))
+
+(test @t{
+ #lang htdp/isl+
+ (define p (make-posn 7 3))
+ (check-expect posn-x 7)
+
+}
+      #f
+      #rx"Ran 1 test.\n0 tests passed."
+      #|
+      check-expect encountered the following error instead of the expected value, 7. 
+         ::  at line 3, column 0 first argument of equality cannot be a function, given posn-x
+      at line 3, column 0
+      |#
+      #:extra-assert
+      (λ (defs ints #:test test)
+        (define re
+          (pregexp
+           (string-append
+            "check-expect[ a-z]+error.*[^\n]+\n"
+            ".*::.*at line 3, column 0 first argument.*function.*given posn-x[^\n]*\n"
+            "at line 3, column 0")))
+        ;; Includes the flattened test result snips.
+        (define full-ints-text
+          (send ints get-text (send ints paragraph-start-position 2) 'eof #t))
+        (define passed?
+          (regexp-match? re full-ints-text))
+        (unless passed?
+          (eprintf "FAILED line ~a: ~a\n  extra assertion expected: ~s\n\n  got: ~a\n"
+                   (test-line test)
+                   (test-definitions test)
+                   re
+                   full-ints-text))
+        passed?))
+
+(test @t{
+ #lang htdp/isl+
+
+
+ (check-random (+ (random 5) (sqrt 2))
+               (+ (random 5) (sqrt 2)))
+
+}
+      #f
+      #rx"check-random.*inexact"
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? #rx"unsaved-editor:4:0"
+                              (srcloc->string loc)))
+             ;; ^ check-random is in the backtrace, not some internal test-engine modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]check-random.*sqrt 2[)][)][)]"
+                                      (test-definitions test)))
+             ;; ^ check-random is highlighted
+             )))
+
+(test @t{
+ #lang htdp/isl+
+
+  (check-within (sqrt 2) 3/2 "0.1")
+
+}
+      #f
+      #rx"check-within.*\"0[.]1\".*not inexact"
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? #rx"unsaved-editor:3:1"
+                              (srcloc->string loc)))
+             ;; ^ check-within is in the backtrace, not some internal test-engine modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]check-within.*0[.]1\"[)]"
+                                      (test-definitions test)))
+             ;; ^ check-within is highlighted
+             )))
+
+(define (close-current-tab-and-open-new-tab filename)
+  (define path (in-here/path filename))
+  (define drs (wait-for-drracket-frame))
+  (test:menu-select "File" "New Tab")
+  (case (system-type 'os)
+    [(macosx windows)
+     (test:menu-select "Windows" (format "Tab 1: ~a" filename))
+     (test:menu-select "File" "Close Tab")]
+    [(unix)
+     (test:menu-select "Tabs" (format "Tab 1: ~a" filename))
+     (test:menu-select "File" "Close")])
+  (when (file-exists? path)
+    (delete-file path)))
+
+(let ([filename @t{gh208-pr229-islplus.rkt}])
+(test #:before-execute (λ () (save-drracket-window-as
+                              (string->path (in-here/path filename))))
+      #:after-test (λ () (close-current-tab-and-open-new-tab filename))
+      #:wait-for-drracket-frame-after-test? #t
+      @t{
+ #lang htdp/isl+
+
+ (define (my-add1 n) (+ n 1))
+ my-add1
+ (check-expect my-add1 2)
+
+ (let ([keep-parity (lambda (m)
+                      (+ m 2))])
+   keep-parity)
+
+ (local [(define alt-parity (lambda (m)
+                              (- 1 m)))]
+   alt-parity)
+
+ (let ()
+   (lambda (m)
+     (+ m 2)))
+
+ (local [(define lam-in-if
+          (if (> (random 10) 5)
+              (lambda (x) (+ x 5))
+              (lambda (y) (* y 2))))]
+  lam-in-if)
+
+}
+      #f
+      @rx{^my-add1
+          keep-parity
+          alt-parity
+          [(]lambda [(]a1[)] [.][.][.][)]
+          lam-in-if
+          Ran 1 test[.]
+          0 tests passed[.]}
+      #:extra-assert
+      (λ (defs ints #:test test)
+        (define ^\n "[^\n]+")
+        (define re
+          (pregexp
+           @t{::\s+in @(regexp-quote filename), line 5, column 0@|^\n|function@|^\n|given my-add1}))
+        ;; Includes the flattened test result snips.
+        (define full-ints-text
+          (send ints get-text (send ints paragraph-start-position 2) 'eof #t))
+        (define passed?
+          (regexp-match? re full-ints-text))
+        (unless passed?
+          (eprintf "FAILED line ~a: ~a\n  extra assertion expected: ~s\n\n  got: ~a\n"
+                   (test-line test)
+                   (test-definitions test)
+                   re
+                   full-ints-text)
+          (flush-output (current-error-port))
+          (sleep/yield 0.1))
+        passed?)))
+
+;; Run the same test, but in an unsaved buffer.
+(test @t{
+ #lang htdp/isl+
+
+ (define (my-add1 n) (+ n 1))
+ my-add1
+ (check-expect my-add1 2)
+
+ (let ([keep-parity (lambda (m)
+                      (+ m 2))])
+   keep-parity)
+
+ (local [(define alt-parity (lambda (m)
+                              (- 1 m)))]
+   alt-parity)
+
+ (let ()
+   (lambda (m)
+     (+ m 2)))
+
+ (local [(define lam-in-if
+          (if (> (random 10) 5)
+              (lambda (x) (+ x 5))
+              (lambda (y) (* y 2))))]
+  lam-in-if)
+
+}
+      #f
+      @rx{^my-add1
+          keep-parity
+          alt-parity
+          [(]lambda [(]a1[)] [.][.][.][)]
+          lam-in-if
+          Ran 1 test[.]
+          0 tests passed[.]}
+      #:extra-assert
+      (λ (defs ints)
+        (regexp-match? #px"::\\s+at line 5, column 0[^\n]+function[^\n]+given my-add1"
+                       ;; Includes the flattened test result snips.
+                       (send ints get-text (send ints paragraph-start-position 2) 'eof #t))))
+
+(let ([filename @t{gh208-pr229-isl.rkt}])
+(test #:before-execute (λ () (save-drracket-window-as
+                              (string->path (in-here/path filename))))
+      #:after-test (λ () (close-current-tab-and-open-new-tab filename))
+      #:wait-for-drracket-frame-after-test? #t
+      @t{
+ #lang htdp/isl
+
+ (define (my-add1 n) (+ n 1))
+ my-add1
+ (check-expect my-add1 2)
+
+ (let ([keep-parity (lambda (m)
+                      (+ m 2))])
+   keep-parity)
+
+ (local [(define alt-parity (lambda (m)
+                              (- 1 m)))]
+   alt-parity)
+
+}
+      #f
+      @rx{^function:my-add1
+          function:keep-parity
+          function:alt-parity
+          Ran 1 test[.]
+          0 tests passed[.]}
+      #:extra-assert
+      (λ (defs ints)
+        (define ^\n "[^\n]+")
+        (regexp-match?
+         (pregexp
+          @t{::\s+in @(regexp-quote filename), line 5, column 0@|^\n|function@|^\n|given function:my-add1})
+         ;; Includes the flattened test result snips.
+         (send ints get-text (send ints paragraph-start-position 2) 'eof #t)))))
+
+;; Run the same test, but in an unsaved buffer.
+(test @t{
+ #lang htdp/isl
+
+ (define (my-add1 n) (+ n 1))
+ my-add1
+ (check-expect my-add1 2)
+
+ (let ([keep-parity (lambda (m)
+                      (+ m 2))])
+   keep-parity)
+
+ (local [(define alt-parity (lambda (m)
+                              (- 1 m)))]
+   alt-parity)
+
+}
+      #f
+      @rx{^function:my-add1
+          function:keep-parity
+          function:alt-parity
+          Ran 1 test[.]
+          0 tests passed[.]}
+      #:extra-assert
+      (λ (defs ints)
+        (regexp-match? #px"::\\s+at line 5, column 0[^\n]+function[^\n]+given function:my-add1"
+                       ;; Includes the flattened test result snips.
+                       (send ints get-text (send ints paragraph-start-position 2) 'eof #t))))
+
+(let ([filename @t{htdp-tests-intm-lam-map.rkt}])
+(test #:before-execute (λ () (save-drracket-window-as
+                              (string->path (in-here/path filename))))
+      #:after-test (λ () (close-current-tab-and-open-new-tab filename))
+      #:wait-for-drracket-frame-after-test? #t
+      @t{
+#lang htdp/isl+
+   (map (lambda (x y) (+ x y)) (list 2 3 4))
+}
+      #f
+      @rx{map: first argument must be a function that expects one argument,
+          given @regexp-quote{(lambda (a1 a2) ...)}}
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? @rx{@(regexp-quote filename):2:3}
+                              (srcloc->string loc)))
+             ;; ^ foldr is in the backtrace, not some internal HtDP modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]map.*3 4[)][)]"
+                                      (test-definitions test)))
+             ;; ^ foldr is highlighted
+             ))))
+
+(let ([filename @t{htdp-tests-intm-lam-foldr2.rkt}])
+(test #:before-execute (λ () (save-drracket-window-as
+                              (string->path (in-here/path filename))))
+      #:after-test (λ () (close-current-tab-and-open-new-tab filename))
+      #:wait-for-drracket-frame-after-test? #t
+      @t{
+#lang htdp/isl+
+   (foldr (lambda (x y) (+ x y)) 0 (list 2 3 4) (list 2 3 4))
+}
+      #f
+      @rx{foldr: first argument must be a function that expects three arguments,
+          given @regexp-quote{(lambda (a1 a2) ...)}}
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? @rx{@(regexp-quote filename):2:3}
+                              (srcloc->string loc)))
+             ;; ^ foldr is in the backtrace, not some internal HtDP modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]foldr.*3 4[)][)]"
+                                      (test-definitions test)))
+             ;; ^ foldr is highlighted
+             ))))
+
+(let ([filename @t{htdp-tests-intm-lam-foldr3.rkt}])
+(test #:before-execute (λ () (save-drracket-window-as
+                              (string->path (in-here/path filename))))
+      #:after-test (λ () (close-current-tab-and-open-new-tab filename))
+      #:wait-for-drracket-frame-after-test? #t
+      @t{
+#lang htdp/isl+
+   (foldr (lambda (x y z) (+ x y z)) 0 (list 2 3 4))
+}
+      #f
+      @rx{foldr: first argument must be a function that expects two arguments,
+          given @regexp-quote{(lambda (a1 a2 a3) ...)}}
+      #:extra-assert
+      (λ (defs ints #:stacks stacks #:test test)
+        (and (for*/or ([stack (in-list stacks)]
+                       #:when stack
+                       [loc (in-list (viewable-stack->red-arrows-backtrace-srclocs stack))])
+               (regexp-match? @rx{@(regexp-quote filename):2:3}
+                              (srcloc->string loc)))
+             ;; ^ foldr is in the backtrace, not some internal HtDP modules
+             (equal?
+              (remove-duplicates
+               (for/list ([range (send defs get-highlighted-ranges)])
+                 (cons (text:range-start range) (text:range-end range))))
+              (regexp-match-positions #rx"[(]foldr.*3 4[)][)]"
+                                      (test-definitions test)))
+             ;; ^ foldr is highlighted
+             ))))
+
+(test @t{#lang htdp/isl
+         (check-expect (* 2 3) 6)
+         (check-expect (+ 2 3) 5)}
+      #f
+      #rx"^Both tests passed!$")
+
+(test @t{#lang htdp/isl}
+      ;; REPL
+      @t{(check-expect (* 2 3) 6)
+         (check-expect (+ 2 3) 5)}
+      #rx"^The test passed!\nThe test passed!$")
+
+(test @t{#lang htdp/isl
+         (check-expect (* 2 3) 6)
+         (check-expect (* 2 3) 5)}
+      #f
+      #rx"^Ran 2 tests[.]\n1 of the 2 tests failed[.].*Check failures:")
+
+(test @t{#lang htdp/isl}
+      ;; REPL
+      @t{(check-expect (* 2 3) 6)
+         (check-expect (* 2 3) 5)}
+      #rx"^The test passed!\nRan 1 test[.]\n0 tests passed[.].*Check failures:")
+
+(test @t{#lang htdp/isl}
+      ;; REPL
+      @t{(check-expect (* 2 3) 5)
+         (check-expect (* 2 3) 6)}
+      #rx"^Ran 1 test[.]\n0 tests passed[.].*Check failures:.*\nThe test passed!$")
+
+(test @t{#lang htdp/isl
+         (check-expect (* 2 3) 6)
+         (check-expect (* 2 3) 5)
+         (check-expect (+ 2 3) 5)}
+      ;; REPL
+      @t{(check-expect (+ 4 5) 9)
+         (check-expect (+ 6 7) 42)
+         (check-expect (* 8 9) 72)
+         (check-expect (error 'oops) 111)}
+      #px"^Ran 3 tests[.]\\s+1 of the 3 tests failed[.]"
+      #t
+      #:extra-assert
+      (λ (defs ints #:test test)
+        (define re
+          (pregexp
+           @t{^Ran 3 tests[.]
+              1 of the 3 tests failed[.]
+
+              Check failures:\s*
+                +Actual value 6 differs from 5, the expected value[.]\s*
+              at line 3, column 0
+              > @(regexp-quote (test-interactions test))
+              The test passed!
+              Ran 1 test[.]
+              0 tests passed[.]
+
+              Check failures:\s*
+                +Actual value 13 differs from 42, the expected value[.]\s*
+              at line 10, column 0
+              The test passed!
+              Ran 1 test[.]
+              0 tests passed[.]
+
+              Check failures:\s*
+                +check-expect encountered the following error instead of the expected value, 111[.]\s*
+                +:: +at line 12, column 14 oops:\s*
+              at line 12, column 0
+              > }))
+        ;; Includes the flattened test result snips.
+        (define full-ints-text
+          (send ints get-text (send ints paragraph-start-position 2) 'eof #t))
+        (define passed?
+          (regexp-match? re full-ints-text))
+        (unless passed?
+          (eprintf "FAILED line ~a: ~a\n  extra assertion expected: ~s\n\n  got: ~a\n"
+                   (test-line test)
+                   (test-definitions test)
+                   re
+                   full-ints-text)
+          (flush-output (current-error-port))
+          (sleep/yield 0.1))
+        passed?))
+
 (fire-up-drracket-and-run-tests run-test)
 
 ;; Test mode:
 (module test racket/base
-  (require syntax/location)
+  (require racket/port syntax/location)
+  (define-values (inp outp) (make-pipe))
+  (define tee-error-port (open-output-bytes 'tee-stderr))
+  (define stderr (current-error-port))
+  (void
+   (thread
+    (λ () (copy-port inp tee-error-port stderr))))
+  (exit-handler
+   (let ([old-exit-hdlr (exit-handler)])
+     (λ (code)
+       (define stderr-content-length
+         (bytes-length (get-output-bytes tee-error-port #t)))
+       (cond
+         [(and (zero? code) (> stderr-content-length 0))
+          (write-string "non-empty stderr\n" stderr)
+          (old-exit-hdlr 1)]
+         [else
+          (old-exit-hdlr code)]))))
   (putenv "PLTDRTEST" "yes")
   (eval-jit-enabled #f)
-  (dynamic-require (quote-module-path "..") #f)
+  (parameterize ([current-error-port outp])
+    (dynamic-require (quote-module-path "..") #f))
   (module config info
     (define timeout 800)))
diff --git a/drracket-test/tests/drracket/private/drracket-test-util.rkt b/drracket-test/tests/drracket/private/drracket-test-util.rkt
index b7c7b4a0d..507729b50 100644
--- a/drracket-test/tests/drracket/private/drracket-test-util.rkt
+++ b/drracket-test/tests/drracket/private/drracket-test-util.rkt
@@ -649,6 +649,7 @@
                      (if (exn? x)
                          (orig-display-handler (exn-message x) x)
                          (eprintf "uncaught exception ~s\n" x))
+                     (sleep/yield 0.1)
                      (exit 1))))
                 (run-test)
                 (test-log #:display? #t #:exit? #t)
diff --git a/drracket-test/tests/drracket/private/module-lang-test-utils.rkt b/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
index 3ebb5df26..3c68ea7fd 100644
--- a/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
+++ b/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
@@ -6,7 +6,8 @@
          (for-syntax racket/base)
          racket/class)
 
-(provide test t rx run-test 
+(provide test t rx run-test
+         (struct-out test-struct)
          in-here in-here/path write-test-modules)
 
 ;; utilities to use with scribble/reader
@@ -14,15 +15,18 @@
 (define (rx . strs)
   (regexp (regexp-replace* #rx" *\n *" (string-append* strs) ".*")))
 
-(define-struct test
+(struct test
   (definitions    ; Rec X = (or/c string 'xml-box (listof X))
     interactions  ; (union #f string)
     result        ; (or/c string regexp)
     all?          ; boolean (#t => compare all of the text between the 3rd and n-1-st line)
+    before-exec   ; (-> any)
+    after-test    ; (-> any)
+    wait-for-drracket-frame-after-test? ; boolean
     extra-assert  ; (-> (is-a?/c text) (is-a?/c text) boolean)
     line)         ; number or #f: the line number of the test case
-
-  #:omit-define-syntaxes)
+  #:name test-struct
+  #:constructor-name make-test)
 
 (define (in-here/path file) (path->string (build-path (find-system-path 'temp-dir) file)))
 (define (in-here file) (format "~s" (in-here/path file)))
@@ -34,11 +38,17 @@
      (with-syntax ([line (syntax-line stx)])
        #'(test/proc line args ...))]))
 (define (test/proc line definitions interactions results [all? #f]
-                   #:extra-assert [extra-assert (λ (x y) #t)])
+                   #:extra-assert [extra-assert (λ (x y) #t)]
+                   #:before-execute [before-exec (λ () (void))]
+                   #:after-test [after-test (λ () (void))]
+                   #:wait-for-drracket-frame-after-test? [wait-for-drs? #f])
   (set! tests (cons (make-test definitions
                                interactions 
                                results 
-                               all? 
+                               all?
+                               before-exec
+                               after-test
+                               wait-for-drs?
                                extra-assert
                                line)
                     tests)))
@@ -81,6 +91,7 @@
          (error 'module-lang-test-utils.rkt
                 "unknown thing in test-definitions field ~s"
                 to-handle)]))
+    ((test-before-exec test))
     (do-execute drs)
     
     (define ints (test-interactions test))
@@ -176,18 +187,34 @@
                 (when has-next?
                   (loop))))
             (eprintf "----\n")))))
-    (unless ((test-extra-assert test) definitions-text interactions-text)
+    (define the-assert (test-extra-assert test))
+    (define-values (kws-req kws-acc) (procedure-keywords the-assert))
+    (define-values (kws kw-vals)
+      (for/lists (kws kw-vals)
+                 ;; the keywords must be sorted
+                 ([kw-val (in-list `((#:stacks . ,stacks)
+                                     (#:test . ,test)
+                                     (#:text . ,text)))]
+                  #:when (or (not kws-acc) (memq (car kw-val) kws-acc)))
+        (values (car kw-val) (cdr kw-val))))
+    (unless (keyword-apply the-assert kws kw-vals definitions-text interactions-text '())
       (eprintf "FAILED line ~a; extra assertion returned #f\n"
-               (test-line test)))))
+               (test-line test)))
+    ((test-after-test test))
+    (when (test-wait-for-drracket-frame-after-test? test)
+      (retrieve-drracket-frames!))))
 
 (define drs 'not-yet-drs-frame)
 (define interactions-text 'not-yet-interactions-text)
 (define definitions-text 'not-yet-definitions-text)
 
-(define (run-test)
+(define (retrieve-drracket-frames!)
   (set! drs (wait-for-drracket-frame))
   (set! interactions-text  (send drs get-interactions-text))
-  (set! definitions-text (send drs get-definitions-text))
+  (set! definitions-text (send drs get-definitions-text)))
+
+(define (run-test)
+  (retrieve-drracket-frames!)
   (init-temp-files)
   (run-use-compiled-file-paths-tests)
   (set-module-language! #f)