80 lines
2.1 KiB
Haskell
80 lines
2.1 KiB
Haskell
module Gyehoek.Test.CPS.Eval where
|
|
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.HUnit
|
|
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
|
|
import Gyehoek.CPS.Eval qualified as Sut
|
|
import Data.List (List)
|
|
import Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFail)
|
|
import System.Directory (listDirectory)
|
|
import Test.Tasty.Silver
|
|
import System.FilePath
|
|
import Control.Exception
|
|
import qualified Gyehoek.Driver as Driver
|
|
import Control.DeepSeq (($!!))
|
|
import System.Exit (ExitCode(..))
|
|
import qualified Data.Text as T
|
|
import Data.Function (applyWhen)
|
|
import Gyehoek.Prelude
|
|
|
|
|
|
brokenEvalTests :: List String
|
|
brokenEvalTests =
|
|
[]
|
|
-- [ "adder"
|
|
-- , "apply2"
|
|
-- , "apply-twice"
|
|
-- , "arith"
|
|
-- , "begin-1"
|
|
-- , "callcc-constant"
|
|
-- , "callcc-discard"
|
|
-- , "callcc-early-exit-1"
|
|
-- , "callcc-early-exit-2"
|
|
-- , "callcc-early-exit-3"
|
|
-- , "callcc-early-exit-4"
|
|
-- , "callcc-early-exit-5"
|
|
-- , "callcc-early-exit-6"
|
|
-- , "callcc-nested-1"
|
|
-- , "callcc-nested-2"
|
|
-- , "complicated-1"
|
|
-- , "cons-1"
|
|
-- , "factorial"
|
|
-- , "false"
|
|
-- , "fn-of-fn"
|
|
-- , "if-false"
|
|
-- , "if-number"
|
|
-- , "if-true"
|
|
-- , "lambda"
|
|
-- , "letrec-fn"
|
|
-- , "let-fn"
|
|
-- , "lit-int"
|
|
-- , "square"
|
|
-- , "true"
|
|
-- ]
|
|
|
|
test_eval :: IO TestTree
|
|
test_eval = do
|
|
cs <- listDirectory "golden/exec"
|
|
<&> fmap ("golden/exec" </>)
|
|
pure $ testGroup "cps interpreter"
|
|
[ testGroup "higher-order" $ cpsCase Driver.eval_cps2_e2e <$> cs
|
|
, testGroup "first-order" $ cpsCase Driver.eval_cps_e2e <$> cs
|
|
]
|
|
|
|
maybeBroken name broken = applyWhen (name `elem` broken) expectFail
|
|
|
|
cpsCase :: (FilePath -> IO Text) -> FilePath -> TestTree
|
|
cpsCase f test =
|
|
maybeBroken testName brokenEvalTests $
|
|
goldenVsAction testName resultFile action printProcResult
|
|
where
|
|
testName = takeFileName test
|
|
resultFile = test </> "exec"
|
|
sourceFile = test </> "source.scm"
|
|
action = catch @SomeException
|
|
(do r <- f sourceFile
|
|
pure $!! ( ExitSuccess
|
|
, r
|
|
, "" ))
|
|
\e -> pure (ExitFailure 1, "", T.pack $ displayException e)
|