mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-14 07:51:12 +03:00
easytest.pending runs hidden tests and reports accordingly
This commit is contained in:
parent
bf59f60076
commit
eb4b1bb66b
@ -352,9 +352,30 @@ crash msg = do
|
|||||||
msg' = msg ++ " " ++ prettyCallStack trace
|
msg' = msg ++ " " ++ prettyCallStack trace
|
||||||
Test (Just <$> putResult Failed) >> noteScoped ("FAILURE " ++ msg') >> Test (pure Nothing)
|
Test (Just <$> putResult Failed) >> noteScoped ("FAILURE " ++ msg') >> Test (pure Nothing)
|
||||||
|
|
||||||
-- skips the test but makes a note of this fact
|
-- | Overwrites the env so that note_ (the logger) is a no op
|
||||||
pending :: Test a -> Test a
|
nologging :: HasCallStack => Test a -> Test a
|
||||||
pending _ = Test (Nothing <$ putResult Pending)
|
nologging (Test t) = Test $ do
|
||||||
|
env <- ask
|
||||||
|
liftIO $ runReaderT t (env {note_ = \_ -> pure ()})
|
||||||
|
|
||||||
|
-- | Run a test under a new scope, without logs and suppressing all output
|
||||||
|
attempt :: Test a -> Test (Maybe a)
|
||||||
|
attempt (Test t) = nologging $ do
|
||||||
|
env <- ask
|
||||||
|
let msg = "internal attempt"
|
||||||
|
let messages' = case messages env of [] -> msg; ms -> ms ++ ('.':msg)
|
||||||
|
liftIO $ runWrap env { messages = messages', allow = "not visible" } t
|
||||||
|
|
||||||
|
-- | Placeholder wrapper for a failing test. The test being wrapped is expected/known to fail.
|
||||||
|
-- Will produce a failure if the test being wrapped suddenly becomes a success.
|
||||||
|
pending :: HasCallStack => Test a -> Test a
|
||||||
|
pending test = do
|
||||||
|
m <- attempt test
|
||||||
|
case m of
|
||||||
|
Just _ ->
|
||||||
|
crash "This pending test should not pass!"
|
||||||
|
Nothing ->
|
||||||
|
ok >> Test (pure Nothing)
|
||||||
|
|
||||||
putResult :: Status -> ReaderT Env IO ()
|
putResult :: Status -> ReaderT Env IO ()
|
||||||
putResult passed = do
|
putResult passed = do
|
||||||
|
@ -12,6 +12,12 @@ suite1 = tests
|
|||||||
, scope "b" . scope "c" . scope "d" $ ok
|
, scope "b" . scope "c" . scope "d" $ ok
|
||||||
, scope "c" ok ]
|
, scope "c" ok ]
|
||||||
|
|
||||||
|
suite2 :: Test ()
|
||||||
|
suite2 = tests
|
||||||
|
[ scope "pending.failure" (pending (expectEqual True False))
|
||||||
|
--, scope "pending.success" (pending ok)
|
||||||
|
]
|
||||||
|
|
||||||
reverseTest :: Test ()
|
reverseTest :: Test ()
|
||||||
reverseTest = scope "list reversal" $ do
|
reverseTest = scope "list reversal" $ do
|
||||||
nums <- listsOf [0..100] (int' 0 99)
|
nums <- listsOf [0..100] (int' 0 99)
|
||||||
@ -25,3 +31,4 @@ main = do
|
|||||||
runOnly "b" $ tests [suite1, scope "xyz" (crash "never run")]
|
runOnly "b" $ tests [suite1, scope "xyz" (crash "never run")]
|
||||||
runOnly "b.c" $ tests [suite1, scope "b" (crash "never run")]
|
runOnly "b.c" $ tests [suite1, scope "b" (crash "never run")]
|
||||||
run reverseTest
|
run reverseTest
|
||||||
|
run suite2
|
||||||
|
Loading…
Reference in New Issue
Block a user