tasty-discover
build / build (push) Successful in 1m27s

This commit is contained in:
2026-08-20 06:04:31 -06:00
parent fc8cf263aa
commit baa5d248fd
9 changed files with 48 additions and 56 deletions
+2
View File
@@ -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
+4 -5
View File
@@ -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|
+2 -3
View File
@@ -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
+8 -9
View File
@@ -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"]))
+4 -3
View File
@@ -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"
+2 -3
View File
@@ -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
]
+2 -9
View File
@@ -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
]
+2 -3
View File
@@ -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
View File
@@ -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
-- ]