112 lines
3.2 KiB
Haskell
112 lines
3.2 KiB
Haskell
module Gyehoek.Test.Golden where
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.Silver
|
|
import Gyehoek.Driver qualified as Driver
|
|
import System.FilePath
|
|
import Data.List (List)
|
|
import Data.Functor ((<&>))
|
|
import System.Directory
|
|
import Data.Function
|
|
import System.Environment.Blank (getEnvDefault)
|
|
import qualified System.Process.Text as PT
|
|
import Control.Exception (SomeException (SomeException), Exception (..), catch)
|
|
import Gyehoek.Stack.VM (writeObj)
|
|
import Data.Text qualified as T
|
|
import System.Exit (ExitCode(..))
|
|
import Test.Tasty.ExpectedFailure (expectFail, ignoreTestBecause)
|
|
import Control.DeepSeq (($!!))
|
|
import Text.Pretty.Simple (pShow, pShowNoColor)
|
|
import Control.Lens (strict, view)
|
|
import Gyehoek.Sexp.Read qualified as Read
|
|
import Effectful
|
|
|
|
|
|
brokenWasmTests :: List String
|
|
brokenWasmTests =
|
|
[
|
|
]
|
|
|
|
brokenStackifyTests :: List String
|
|
brokenStackifyTests =
|
|
[]
|
|
-- [ "adder"
|
|
-- , "let-fn"
|
|
-- , "callcc-nested1" -- requires closure-conversion
|
|
-- ]
|
|
|
|
brokenReaderTests =
|
|
[ "delimited-identifier"
|
|
, "string-line-continuation"
|
|
]
|
|
|
|
test_root :: IO TestTree
|
|
test_root = do
|
|
all_cases <- listDirectory "golden/exec"
|
|
let tests = all_cases
|
|
& fmap ("golden/exec"</>)
|
|
testGroup "execution" <$> sequenceA
|
|
[ ignoreTestBecause "wasm codegen is on the backburner"
|
|
<$> wasmTests tests
|
|
, stackifyTests tests
|
|
]
|
|
|
|
maybeBroken name broken = applyWhen (name `elem` broken) expectFail
|
|
|
|
wasmTests :: List FilePath -> IO TestTree
|
|
wasmTests files = do
|
|
cmd <- getEnvDefault "GYEHOEK_RUNTIME"
|
|
"runtime/target/debug/gyehoek-runtime"
|
|
pure $ testGroup "wasm" $ files <&> \test ->
|
|
let testname = takeFileName test
|
|
scmfile = test </> "source.scm"
|
|
resultfile = test </> "exec"
|
|
action = do
|
|
t <- Driver.lower_e2e scmfile
|
|
PT.readProcessWithExitCode cmd ["-"] t
|
|
in maybeBroken testname brokenWasmTests $
|
|
goldenVsAction
|
|
testname
|
|
resultfile
|
|
action
|
|
printProcResult
|
|
|
|
stackifyTests :: List FilePath -> IO TestTree
|
|
stackifyTests files = do
|
|
pure $ testGroup "stackified" $ files <&> \test ->
|
|
let testname = takeFileName test
|
|
scmfile = test </> "source.scm"
|
|
resultfile = test </> "exec"
|
|
action =
|
|
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
|
|
resultfile
|
|
action
|
|
printProcResult
|
|
|
|
test_reader :: IO TestTree
|
|
test_reader = do
|
|
all_cases <- listDirectory "golden/reader"
|
|
let tests = all_cases
|
|
& fmap ("golden/reader"</>)
|
|
pure . testGroup "reader" $ tests <&> \test ->
|
|
let testname = takeFileName test
|
|
scmfile = test </> "source.scm"
|
|
resultfile = test </> "read"
|
|
action = runEff $ Read.readFile scmfile
|
|
in maybeBroken testname brokenReaderTests $ goldenVsAction
|
|
testname
|
|
resultfile
|
|
action
|
|
(view strict . pShowNoColor)
|
|
|
|
-- readTests files = pure . testGroup "reader" $ files <&> \test ->
|
|
-- let
|