tasty-discover

gyehoek.cabal

@@ -103,10 +103,11 @@ library
   default-language: GHC2024
 
 test-suite test
-  import:           ghcstuffs, ghcstuffs-dev
+  import:             ghcstuffs, ghcstuffs-dev
-  type:             exitcode-stdio-1.0
+  type:               exitcode-stdio-1.0
-  hs-source-dirs:   test
+  hs-source-dirs:     test
-  main-is:          Main.hs
+  main-is:            Main.hs
+  build-tool-depends: tasty-discover:tasty-discover
   other-modules:
     Gyehoek.Test.CPS.Eval
     Gyehoek.Test.CPS.Stackify
@@ -115,6 +116,7 @@ test-suite test
     Gyehoek.Test.Scheme.Syntax
     Gyehoek.Test.Sexp
     Gyehoek.Test.Stack.VM
+    Root
 
   build-depends:
     , base
@@ -133,4 +135,4 @@ test-suite test
     , tasty-silver
     , text
 
-  default-language: GHC2024
+  default-language:   GHC2024

src/Gyehoek/Prelude.hs

@@ -1,7 +1,7 @@
 module Gyehoek.Prelude
   ( module Control.Lens
   , module Effectful
-  , module Data.Generics.Labels
+  , module Data.Generics.Labels -- exports instances
   , module Data.String.Interpolate
   , Text
   , List

test/Gyehoek/Test/CPS/Eval.hs

@@ -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
+test_cpsInterpreter = testGroup "cps interpreter" $
-root = pure . testGroup "cps interpreter" $
+  [ primitives
-  [ prim
   , 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|

test/Gyehoek/Test/CPS/Stackify.hs

@@ -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
+test_stackify =
-root = pure . testGroup "stackify" $
   [ trivialReturn
   , tailCall
   , prim

test/Gyehoek/Test/CPS/Syntax.hs

@@ -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
+test_root = testGroup "cps syntax"
-root = pure . testGroup "cps syntax" $
+  [ free
-  [ qqTree
+  , qq
-  , freeTree
   ]
 
-freeTree :: TestTree
+free :: TestTree
-freeTree = testGroup "free"
+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
+qq :: TestTree
-qqTree = testGroup "parser"
+qq = testGroup "parser"
   [ testCase "lambda" do
       assertEqual "" (Sut.MkLambda ["x","y"] "ktail"
                (Sut.ExpContinue "ktail" [Sut.ValVar "x"]))

test/Gyehoek/Test/Golden.hs

@@ -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
+test_root :: IO TestTree
-root = do
+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"

test/Gyehoek/Test/Scheme/Syntax.hs

@@ -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
+test_root = testGroup "scheme syntax" $
-root = pure . testGroup "scheme syntax" $
   [ freeTree
   ]
 

test/Gyehoek/Test/Sexp.hs

@@ -1,10 +1,4 @@
-module Gyehoek.Test.Sexp
+module Gyehoek.Test.Sexp where
-  ( root
-  , EquivSexp(..)
-  , assertEquiv
-  , equivto
-  )
-  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
+test_root = testGroup "sexp" $
-root = pure . testGroup "sexp" $
   [ sxTree
   ]
 

test/Gyehoek/Test/Stack/VM.hs

@@ -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
+test_root = testGroup "stack machine" $
-root = pure . testGroup "stack machine" $
   [ lit_int
   , procedure
   , prims

test/Main.hs

@@ -1,27 +1,18 @@
 module Main (main) where
 
-import Test.Tasty (TestTree, testGroup)
+-- import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Silver.Interactive (defaultMain)
-import qualified Gyehoek.Test.Golden
+-- import qualified Gyehoek.Test.Golden
-import qualified Gyehoek.Test.Sexp
+-- import qualified Gyehoek.Test.Sexp
-import qualified Gyehoek.Test.CPS.Syntax
+-- import qualified Gyehoek.Test.CPS.Syntax
-import qualified Gyehoek.Test.Scheme.Syntax
+-- import qualified Gyehoek.Test.Scheme.Syntax
-import qualified Gyehoek.Test.Stack.VM
+-- import qualified Gyehoek.Test.Stack.VM
-import qualified Gyehoek.Test.CPS.Stackify
+-- import qualified Gyehoek.Test.CPS.Stackify
-import qualified Gyehoek.Test.CPS.Eval
+-- import qualified Gyehoek.Test.CPS.Eval
+import qualified Root
 
 
 main :: IO ()
-main = defaultMain =<< root
+main = do
-
+  discoveredTests <- Root.tests
-root :: IO TestTree
+  defaultMain discoveredTests
-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
-  ]
-

test/Root.hs

@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC
+  -F -pgmF tasty-discover
+  -optF --no-main
+  -optF --generated-module=Root
+#-}
+module Root where