add: more prototype code for multi-test-failure testing

tnelson · Feb 21, 2024 · 09c7f03 · 09c7f03
1 parent 53fd0aa
commit 09c7f03
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 5 deletions.
diff --git a/forge/lang/reader.rkt b/forge/lang/reader.rkt
@@ -133,13 +133,14 @@
 
                   ;; Declare submodule "execs". Macros like "test" or "run" etc. will add to
                   ;; this submodule.
+                  ;; TODO: is this line now unnecessary, since the following line declares execs?
                   (module+ execs)
+                  ; After execution of execs, print test failures (if any)
+                  (module+ execs (output-all-test-failures))
                   ;; Declare submodule "main"
                   (module+ main
                     ; Invoke the execs submodule
-                    (require (submod ".." execs))
-                    ; After execution of execs, print test failures (if any)
-                    (output-all-test-failures))                                    
+                    (require (submod ".." execs)))                                    
 
                   (log:flush-logs ',compile-time "no-error")))
 

diff --git a/forge/tests/error/main.rkt b/forge/tests/error/main.rkt
@@ -13,7 +13,8 @@
 (require
   rackunit
   (only-in rackunit/text-ui run-tests)
-  racket/runtime-path)
+  racket/runtime-path
+  racket/port)
 
 (define-runtime-path here ".")
 
@@ -142,12 +143,23 @@
     (define test-name (car test+pred*))
     (define pred (cadr test+pred*))
     (printf "run test: ~a~n" test-name)
+
+
     (with-check-info*
       (list (make-check-name test-name))
       (lambda ()
-        (check-exn pred (lambda () (re-raise-strings (run-error-test test-name))))))
+        (check-exn pred (lambda ()
+                          (define mocked-stderr (open-output-string))
+                          (parameterize ([current-error-port mocked-stderr])
+                            ; run test-name, and if a non-exception was raised, raise it as a user-error
+                            (re-raise-strings (run-error-test test-name))
+                            ; If we reach this point, no exception was raised. Thus, look in mocked stderr
+                            (re-raise-strings (raise (get-output-string mocked-stderr)))
+                            ; will also fail b/c not exception
+                            )))))
     (void)))
 
+
 (define (run-error-test test-name)
   (parameterize ([current-namespace (make-base-empty-namespace)]
                  [current-directory here])