tools.test: more robust must-fail

diff --git a/basis/tools/test/test-tests.factor b/basis/tools/test/test-tests.factor
index 473335645f5a25ee4b465b25939d1a8f40eb5d8d..03f7f006c9ce76edb147ee3f038bac006812da62 100644 (file)
--- a/basis/tools/test/test-tests.factor
+++ b/basis/tools/test/test-tests.factor
@@ -1,4 +1,18 @@
 IN: tools.test.tests
-USING: tools.test ;
+USING: tools.test tools.test.private namespaces kernel sequences ;
 
 \ test-all must-infer
+
+: fake-unit-test ( quot -- )
+    [
+        "fake" file set
+        V{ } clone test-failures set
+        call
+        test-failures get
+    ] with-scope ; inline
+
+[ 1 ] [
+    [
+        [ "OOPS" ] must-fail
+    ] fake-unit-test length
+] unit-test
\ No newline at end of file

diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor
index b98f58b1430e5b09b35829780de6058a42584831..1ff47e3d7f38d6c78099d1c4525b658f90393a83 100644 (file)
--- a/basis/tools/test/test.factor
+++ b/basis/tools/test/test.factor
@@ -48,17 +48,17 @@ SYMBOL: file
     f file get f failure ;
 
 :: (unit-test) ( output input -- error ? )
-    [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; inline
+    [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ;
 
 : short-effect ( effect -- pair )
     [ in>> length ] [ out>> length ] bi 2array ;
 
 :: (must-infer-as) ( effect quot -- error ? )
-    [ quot infer short-effect effect assert= f f ] [ t ] recover ; inline
+    [ quot infer short-effect effect assert= f f ] [ t ] recover ;
 
 :: (must-infer) ( word/quot -- error ? )
     word/quot dup word? [ '[ _ execute ] ] when :> quot
-    [ quot infer drop f f ] [ t ] recover ; inline
+    [ quot infer drop f f ] [ t ] recover ;
 
 TUPLE: did-not-fail ;
 CONSTANT: did-not-fail T{ did-not-fail }
@@ -66,11 +66,11 @@ CONSTANT: did-not-fail T{ did-not-fail }
 M: did-not-fail summary drop "Did not fail" ;
 
 :: (must-fail-with) ( quot pred -- error ? )
-    [ quot call did-not-fail t ]
-    [ dup pred call [ drop f f ] [ t ] if ] recover ; inline
+    [ { } quot with-datastack drop did-not-fail t ]
+    [ dup pred call( error -- ? ) [ drop f f ] [ t ] if ] recover ;
 
 :: (must-fail) ( quot -- error ? )
-    [ quot call did-not-fail t ] [ drop f f ] recover ; inline
+    [ { } quot with-datastack drop did-not-fail t ] [ drop f f ] recover ;
 
 : experiment-title ( word -- string )
     "(" ?head drop ")" ?tail drop { { CHAR: - CHAR: \s } } substitute >title ;