Use displayException instead of show for showing exceptions

#327
UnkindPartition · Apr 28, 2022 · 4c87d84 · 4c87d84
1 parent 16289a7
commit 4c87d84
Show file tree

Hide file tree

Showing 3 changed files with 5 additions and 6 deletions.
diff --git a/core/Test/Tasty/Core.hs b/core/Test/Tasty/Core.hs
@@ -113,7 +113,7 @@ resultSuccessful r =
 exceptionResult :: SomeException -> Result
 exceptionResult e = Result
   { resultOutcome = Failure $ TestThrewException e
-  , resultDescription = "Exception: " ++ show e
+  , resultDescription = "Exception: " ++ displayException e
   , resultShortDescription = "FAIL"
   , resultTime = 0
   , resultDetailsPrinter = noResultDetails

diff --git a/hunit/Test/Tasty/HUnit/Orig.hs b/hunit/Test/Tasty/HUnit/Orig.hs
@@ -135,7 +135,8 @@ instance (AssertionPredicable t) => AssertionPredicable (IO t)
 -- | Exception thrown by 'assertFailure' etc.
 data HUnitFailure = HUnitFailure (Maybe SrcLoc) String
     deriving (Eq, Show, Typeable)
-instance E.Exception HUnitFailure
+instance E.Exception HUnitFailure where
+  displayException (HUnitFailure mbloc s) = prependLocation mbloc s
 
 prependLocation :: Maybe SrcLoc -> String -> String
 prependLocation mbloc s =

diff --git a/hunit/Test/Tasty/HUnit/Steps.hs b/hunit/Test/Tasty/HUnit/Steps.hs
@@ -25,10 +25,8 @@ instance IsTest TestCaseSteps where
         tme <- getTime
         atomicModifyIORef ref (\l -> ((tme,msg):l, ()))
 
-    hunitResult <- (Right <$> assertionFn stepFn) `catches`
-      [ Handler (\(HUnitFailure mbloc errMsg) -> return $ Left (prependLocation mbloc errMsg))
-      , Handler (\(SomeException ex)          -> return $ Left (show ex))
-      ]
+    hunitResult <- (Right <$> assertionFn stepFn) `catch`
+        \(SomeException ex) -> return $ Left (displayException ex)
 
     endTime <- getTime