fix catching of exceptions in tests

This commit is contained in:
2026-08-18 23:50:13 -06:00
parent eb51f4fff7
commit ca1b53f3d1
11 changed files with 61 additions and 22 deletions
+18 -11
View File
@@ -10,11 +10,12 @@ import System.Directory
import Data.Function
import System.Environment.Blank (getEnvDefault)
import qualified System.Process.Text as PT
import Control.Exception (catches, ErrorCall(..), Handler(..))
import Control.Exception (catches, ErrorCall(..), Handler(..), catch, SomeException (SomeException), Exception (displayException))
import Gyehoek.Stack.VM (writeObj)
import Data.Text qualified as T
import System.Exit (ExitCode(..))
import Test.Tasty.ExpectedFailure (expectFail)
import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
import Control.DeepSeq (($!!))
brokenWasmTests :: List String
@@ -36,8 +37,9 @@ root = do
let tests = all_cases
& fmap ("golden"</>)
testGroup "golden" <$> sequenceA
[ {-wasmTests tests
, -}stackifyTests tests
[ ignoreTestBecause "wasm codegen is on the backburner"
<$> wasmTests tests
, stackifyTests tests
]
maybeBroken name broken = applyWhen (name `elem` broken) expectFail
@@ -65,14 +67,19 @@ stackifyTests files = do
let testname = takeFileName test
scmfile = test </> "source.scm"
resultfile = test </> "exec"
-- action = Driver.eval_e2e' scmfile >>= \case
-- Right rs ->
-- pure ( ExitSuccess
-- , T.unwords . fmap writeObj $ rs
-- , "" )
-- Left e -> pure (ExitFailure 1, "", T.pack $ displayException e)
action =
catches (do rs <- Driver.eval_e2e scmfile
pure ( ExitSuccess
, T.unwords . fmap writeObj $ rs
, "" ))
[ Handler \(ErrorCall s) ->
pure (ExitFailure 1, "", T.pack s)
]
catch @SomeException
(do rs <- Driver.eval_e2e scmfile
pure $!! ( ExitSuccess
, T.unwords . fmap writeObj $ rs
, "" ))
\e -> pure (ExitFailure 1, "", T.pack $ displayException e)
in maybeBroken testname brokenStackifyTests $
goldenVsAction
testname