From eb4b1bb66be5e34479fdc5d7ba636c6de170e6e2 Mon Sep 17 00:00:00 2001
From: pete-ts <pete_t@tutanota.com>
Date: Thu, 26 Mar 2020 19:15:19 +0000
Subject: [PATCH] easytest.pending runs hidden tests and reports accordingly

---
 yaks/easytest/src/EasyTest.hs | 27 ++++++++++++++++++++++++---
 yaks/easytest/tests/Suite.hs  |  7 +++++++
 2 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/yaks/easytest/src/EasyTest.hs b/yaks/easytest/src/EasyTest.hs
index c9c2eb124..0b24efef7 100644
--- a/yaks/easytest/src/EasyTest.hs
+++ b/yaks/easytest/src/EasyTest.hs
@@ -352,9 +352,30 @@ crash msg = do
       msg' = msg ++ " " ++ prettyCallStack trace
   Test (Just <$> putResult Failed) >> noteScoped ("FAILURE " ++ msg') >> Test (pure Nothing)
 
--- skips the test but makes a note of this fact
-pending :: Test a -> Test a
-pending _ = Test (Nothing <$ putResult Pending)
+-- | Overwrites the env so that note_ (the logger) is a no op
+nologging :: HasCallStack => Test a -> Test a
+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 passed = do
diff --git a/yaks/easytest/tests/Suite.hs b/yaks/easytest/tests/Suite.hs
index 9e4bd3f4d..77aad62ae 100644
--- a/yaks/easytest/tests/Suite.hs
+++ b/yaks/easytest/tests/Suite.hs
@@ -12,6 +12,12 @@ suite1 = tests
   , scope "b" . scope "c" . scope "d" $ ok
   , scope "c" ok ]
 
+suite2 :: Test ()
+suite2 = tests
+  [ scope "pending.failure" (pending (expectEqual True False))
+  --, scope "pending.success" (pending ok) 
+  ]
+
 reverseTest :: Test ()
 reverseTest = scope "list reversal" $ do
   nums <- listsOf [0..100] (int' 0 99)
@@ -25,3 +31,4 @@ main = do
   runOnly "b" $ tests [suite1, scope "xyz" (crash "never run")]
   runOnly "b.c" $ tests [suite1, scope "b" (crash "never run")]
   run reverseTest
+  run suite2