From baa5d248fd1d12df6c319ec44eb2da7953c2b50d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 20 Aug 2026 06:04:31 -0600 Subject: [PATCH] tasty-discover --- gyehoek.cabal | 2 ++ test/Gyehoek/Test/CPS/Eval.hs | 9 +++---- test/Gyehoek/Test/CPS/Stackify.hs | 5 ++-- test/Gyehoek/Test/CPS/Syntax.hs | 17 ++++++------ test/Gyehoek/Test/Golden.hs | 7 ++--- test/Gyehoek/Test/Scheme/Syntax.hs | 5 ++-- test/Gyehoek/Test/Sexp.hs | 11 ++------ test/Gyehoek/Test/Stack/VM.hs | 5 ++-- test/Main.hs | 43 +++++++++++++++--------------- 9 files changed, 48 insertions(+), 56 deletions(-) diff --git a/gyehoek.cabal b/gyehoek.cabal index 0c88ccb..a10e74f 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -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 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..b10eb75 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -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 +-- ]