fail tests that return promises that never(-ish) resolve

monte-language · Oct 30, 2018 · d89a080 · d89a080
1 parent 8ce32f3
commit d89a080
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 3 deletions.
diff --git a/loader.mast b/loader.mast
diff --git a/loader.mt b/loader.mt
@@ -180,7 +180,7 @@ def loaderMain() :Vow[Int]:
             when (someMods) ->
                 def [[=> makeRunner] | _, _] := testRunner
                 def stdout := stdio.stdout()
-                def runner := makeRunner(stdout, unsealException)
+                def runner := makeRunner(stdout, unsealException, Timer)
                 def results := runner<-runTests(collectedTests)
                 when (results) ->
                     def fails :Int := results.fails()

diff --git a/mast/testRunner.mt b/mast/testRunner.mt
@@ -156,7 +156,7 @@ def makeAsserter() as DeepFrozen:
 # to the beginning of the line. ~ C.
 def clearLine :Bytes := b`$\x1b[2K$\r`
 
-def makeRunner(stdout, unsealException) as DeepFrozen:
+def makeRunner(stdout, unsealException, Timer) as DeepFrozen:
     var lastSource := null
     var lastTest := null
     var total :Int := 0
@@ -178,12 +178,22 @@ Error in source $source from test $test:
         def info := ` Last source: $lastSource Last test: $lastTest`
         return stdout<-(clearLine + UTF8.encode(counts + info, null))
 
+    def either(left, right):
+        def [p, r] := Ref.promise()
+        left <- _whenMoreResolved(r.resolveRace)
+        right <- _whenMoreResolved(r.resolveRace)
+        return p
+
     def startTest(asserter, k, test):
         total += 1
         running += 1
 
         def st :Str := M.toString(test)
-        return when (test<-(asserter(st))) ->
+        def timeout := Ref.whenResolved(
+            Timer.fromNow(60.0),
+            fn _ { Ref.broken(`Timeout running $test`) },
+        )
+        return when (either(timeout, test<-(asserter(st)))) ->
             lastSource := k
             lastTest := test
             running -= 1