diff --git a/gyehoek.cabal b/gyehoek.cabal index 0c88ccb..2af765d 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -103,10 +103,11 @@ library default-language: GHC2024 test-suite test - import: ghcstuffs, ghcstuffs-dev - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs + import: ghcstuffs, ghcstuffs-dev + 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 @@ -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 diff --git a/src/Gyehoek/Prelude.hs b/src/Gyehoek/Prelude.hs index 236556f..9c863e6 100644 --- a/src/Gyehoek/Prelude.hs +++ b/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 diff --git a/test/Gyehoek/Test/CPS/Eval.hs b/test/Gyehoek/Test/CPS/Eval.hs index 7990309..8f28740 100644 --- a/test/Gyehoek/Test/CPS/Eval.hs +++ b/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 -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| diff --git a/test/Gyehoek/Test/CPS/Stackify.hs b/test/Gyehoek/Test/CPS/Stackify.hs index 24f2618..2713486 100644 --- a/test/Gyehoek/Test/CPS/Stackify.hs +++ b/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 -root = pure . testGroup "stackify" $ +test_stackify = [ trivialReturn , tailCall , prim diff --git a/test/Gyehoek/Test/CPS/Syntax.hs b/test/Gyehoek/Test/CPS/Syntax.hs index a49791c..f32a04d 100644 --- a/test/Gyehoek/Test/CPS/Syntax.hs +++ b/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 -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"])) diff --git a/test/Gyehoek/Test/Golden.hs b/test/Gyehoek/Test/Golden.hs index 4ef0b2d..bd83f50 100644 --- a/test/Gyehoek/Test/Golden.hs +++ b/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 -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" diff --git a/test/Gyehoek/Test/Scheme/Syntax.hs b/test/Gyehoek/Test/Scheme/Syntax.hs index 6eaa4b8..50f9442 100644 --- a/test/Gyehoek/Test/Scheme/Syntax.hs +++ b/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 -root = pure . testGroup "scheme syntax" $ +test_root = testGroup "scheme syntax" $ [ freeTree ] diff --git a/test/Gyehoek/Test/Sexp.hs b/test/Gyehoek/Test/Sexp.hs index 3bacf09..3f8f950 100644 --- a/test/Gyehoek/Test/Sexp.hs +++ b/test/Gyehoek/Test/Sexp.hs @@ -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 ] diff --git a/test/Gyehoek/Test/Stack/VM.hs b/test/Gyehoek/Test/Stack/VM.hs index 23aa0cc..d25663f 100644 --- a/test/Gyehoek/Test/Stack/VM.hs +++ b/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 -root = pure . testGroup "stack machine" $ +test_root = testGroup "stack machine" $ [ lit_int , procedure , prims diff --git a/test/Main.hs b/test/Main.hs index 0f2ad3a..d4deb30 100644 --- a/test/Main.hs +++ b/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.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 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 qualified 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 - ] - +main = do + discoveredTests <- Root.tests + defaultMain discoveredTests diff --git a/test/Root.hs b/test/Root.hs new file mode 100644 index 0000000..ac21308 --- /dev/null +++ b/test/Root.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC + -F -pgmF tasty-discover + -optF --no-main + -optF --generated-module=Root +#-} +module Root where