@@ -107,6 +107,8 @@ test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Main.hs
|
||||
build-tool-depends:
|
||||
tasty-discover:tasty-discover
|
||||
other-modules:
|
||||
Gyehoek.Test.CPS.Eval
|
||||
Gyehoek.Test.CPS.Stackify
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module Gyehoek.Test.CPS.Eval (root) where
|
||||
module Gyehoek.Test.CPS.Eval where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -8,9 +8,8 @@ import Gyehoek.CPS.Eval qualified as Sut
|
||||
import Data.List (List)
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "cps interpreter" $
|
||||
[ prim
|
||||
test_cpsInterpreter = testGroup "cps interpreter" $
|
||||
[ primitives
|
||||
, testCase "halt with constant" do
|
||||
evalsTo [ObjImm (ImmInt 123)] [cps|
|
||||
(continue halt 123)
|
||||
@@ -39,7 +38,7 @@ root = pure . testGroup "cps interpreter" $
|
||||
evalsTo :: HasCallStack => List Obj -> Sut.Program -> Assertion
|
||||
evalsTo rs p = Sut.evalProgram p @?= rs
|
||||
|
||||
prim = testGroup "primitives"
|
||||
primitives = testGroup "primitives"
|
||||
[ testGroup "arith"
|
||||
[ testCase "basic 1" do
|
||||
evalsTo [ObjImm (ImmInt 20)] [cps|
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module Gyehoek.Test.CPS.Stackify (root) where
|
||||
module Gyehoek.Test.CPS.Stackify where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -10,8 +10,7 @@ import Gyehoek.GenSym (runGenSym)
|
||||
import Effectful
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "stackify" $
|
||||
test_stackify =
|
||||
[ trivialReturn
|
||||
, tailCall
|
||||
, prim
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
module Gyehoek.Test.CPS.Syntax (root) where
|
||||
module Gyehoek.Test.CPS.Syntax where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -8,14 +8,13 @@ import Gyehoek.CPS.Syntax (cps)
|
||||
import Gyehoek.CPS.Syntax qualified as Sut
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "cps syntax" $
|
||||
[ qqTree
|
||||
, freeTree
|
||||
test_root = testGroup "cps syntax"
|
||||
[ free
|
||||
, qq
|
||||
]
|
||||
|
||||
freeTree :: TestTree
|
||||
freeTree = testGroup "free"
|
||||
free :: TestTree
|
||||
free = testGroup "free"
|
||||
[ testCase "lambda" do
|
||||
Sut.free' @Sut.Lambda [cps|
|
||||
(lambda (x y z k1) (continue k1 x a b c y))
|
||||
@@ -27,8 +26,8 @@ freeTree = testGroup "free"
|
||||
(continue x y k3))|] @=? ["k3"]
|
||||
]
|
||||
|
||||
qqTree :: TestTree
|
||||
qqTree = testGroup "parser"
|
||||
qq :: TestTree
|
||||
qq = testGroup "parser"
|
||||
[ testCase "lambda" do
|
||||
assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
|
||||
(Sut.ExpContinue "ktail" [Sut.ValVar "x"]))
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module Gyehoek.Test.Golden (root) where
|
||||
module Gyehoek.Test.Golden where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.Silver
|
||||
@@ -31,8 +31,8 @@ brokenStackifyTests =
|
||||
-- , "callcc-nested1" -- requires closure-conversion
|
||||
-- ]
|
||||
|
||||
root :: IO TestTree
|
||||
root = do
|
||||
test_root :: IO TestTree
|
||||
test_root = do
|
||||
all_cases <- listDirectory "golden"
|
||||
let tests = all_cases
|
||||
& fmap ("golden"</>)
|
||||
@@ -43,6 +43,7 @@ root = do
|
||||
]
|
||||
|
||||
maybeBroken name broken = applyWhen (name `elem` broken) expectFail
|
||||
|
||||
wasmTests :: List FilePath -> IO TestTree
|
||||
wasmTests files = do
|
||||
cmd <- getEnvDefault "GYEHOEK_RUNTIME"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module Gyehoek.Test.Scheme.Syntax (root) where
|
||||
module Gyehoek.Test.Scheme.Syntax where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -7,8 +7,7 @@ import Gyehoek.Scheme.Syntax (scm)
|
||||
import Gyehoek.Scheme.Syntax qualified as Sut
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "scheme syntax" $
|
||||
test_root = testGroup "scheme syntax" $
|
||||
[ freeTree
|
||||
]
|
||||
|
||||
|
||||
@@ -1,10 +1,4 @@
|
||||
module Gyehoek.Test.Sexp
|
||||
( root
|
||||
, EquivSexp(..)
|
||||
, assertEquiv
|
||||
, equivto
|
||||
)
|
||||
where
|
||||
module Gyehoek.Test.Sexp where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -14,8 +8,7 @@ import Gyehoek.Sexp (sx, equivalent)
|
||||
import Data.Function (on)
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "sexp" $
|
||||
test_root = testGroup "sexp" $
|
||||
[ sxTree
|
||||
]
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module Gyehoek.Test.Stack.VM (root) where
|
||||
module Gyehoek.Test.Stack.VM where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.HUnit
|
||||
@@ -7,8 +7,7 @@ import Gyehoek.Stack.VM qualified as Sut
|
||||
import Data.List (List)
|
||||
|
||||
|
||||
root :: IO TestTree
|
||||
root = pure . testGroup "stack machine" $
|
||||
test_root = testGroup "stack machine" $
|
||||
[ lit_int
|
||||
, procedure
|
||||
, prims
|
||||
|
||||
+22
-21
@@ -1,27 +1,28 @@
|
||||
{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
|
||||
module Main (main) where
|
||||
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Test.Tasty.Silver.Interactive (defaultMain)
|
||||
import qualified Gyehoek.Test.Golden
|
||||
import qualified Gyehoek.Test.Sexp
|
||||
import qualified Gyehoek.Test.CPS.Syntax
|
||||
import qualified Gyehoek.Test.Scheme.Syntax
|
||||
import qualified Gyehoek.Test.Stack.VM
|
||||
import qualified Gyehoek.Test.CPS.Stackify
|
||||
import qualified Gyehoek.Test.CPS.Eval
|
||||
-- import Test.Tasty (TestTree, testGroup)
|
||||
-- import Test.Tasty.Silver.Interactive (defaultMain)
|
||||
-- import qualified Gyehoek.Test.Golden
|
||||
-- import qualified Gyehoek.Test.Sexp
|
||||
-- import qualified Gyehoek.Test.CPS.Syntax
|
||||
-- import qualified Gyehoek.Test.Scheme.Syntax
|
||||
-- import qualified Gyehoek.Test.Stack.VM
|
||||
-- import qualified Gyehoek.Test.CPS.Stackify
|
||||
-- import qualified Gyehoek.Test.CPS.Eval
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain =<< root
|
||||
-- main :: IO ()
|
||||
-- main = defaultMain =<< root
|
||||
|
||||
root :: IO TestTree
|
||||
root = testGroup "test" <$> sequenceA
|
||||
[ Gyehoek.Test.Golden.root
|
||||
, Gyehoek.Test.Sexp.root
|
||||
, Gyehoek.Test.CPS.Syntax.root
|
||||
, Gyehoek.Test.Scheme.Syntax.root
|
||||
, Gyehoek.Test.Stack.VM.root
|
||||
, Gyehoek.Test.CPS.Stackify.root
|
||||
, Gyehoek.Test.CPS.Eval.root
|
||||
]
|
||||
-- root :: IO TestTree
|
||||
-- root = testGroup "test" <$> sequenceA
|
||||
-- [ Gyehoek.Test.Golden.root
|
||||
-- , Gyehoek.Test.Sexp.root
|
||||
-- , Gyehoek.Test.CPS.Syntax.root
|
||||
-- , Gyehoek.Test.Scheme.Syntax.root
|
||||
-- , Gyehoek.Test.Stack.VM.root
|
||||
-- , Gyehoek.Test.CPS.Stackify.root
|
||||
-- , Gyehoek.Test.CPS.Eval.root
|
||||
-- ]
|
||||
|
||||
|
||||
Reference in New Issue
Block a user