diff --git a/cabal.project b/cabal.project index c2a85db7ca..f338ef81b7 100644 --- a/cabal.project +++ b/cabal.project @@ -64,6 +64,7 @@ allow-newer: brick:base, vector-binary-instances:base, cryptohash-sha256:base, + tasty-hedgehog:tasty, hashable -- Works around: https://github.com/recursion-schemes/recursion-schemes/issues/128. This @@ -74,3 +75,9 @@ package recursion-schemes package regex-tdfa optimization: 2 + +source-repository-package + type: git + location: https://github.com/martijnbastiaan/tasty.git + tag: 48f4a4ab2cfdaabedf94c9aa455bf33d7bf36467 + subdir: core diff --git a/clash-cores/clash-cores.cabal b/clash-cores/clash-cores.cabal index 5fe2ee1c29..3188abb5f1 100644 --- a/clash-cores/clash-cores.cabal +++ b/clash-cores/clash-cores.cabal @@ -149,7 +149,7 @@ test-suite unittests clash-lib, clash-prelude-hedgehog, deepseq, - tasty >= 1.2 && < 1.5, + tasty >= 1.2 && < 1.6, tasty-hunit, tasty-quickcheck, tasty-th, diff --git a/clash-lib/clash-lib.cabal b/clash-lib/clash-lib.cabal index e39d57c0ec..1d1290cdf8 100644 --- a/clash-lib/clash-lib.cabal +++ b/clash-lib/clash-lib.cabal @@ -399,7 +399,7 @@ test-suite unittests lens, pretty-show, quickcheck-text, - tasty >= 1.2 && < 1.5, + tasty >= 1.2 && < 1.6, tasty-hunit, tasty-quickcheck, tasty-th, diff --git a/clash-prelude/clash-prelude.cabal b/clash-prelude/clash-prelude.cabal index 6f943c6b95..e18d51210d 100644 --- a/clash-prelude/clash-prelude.cabal +++ b/clash-prelude/clash-prelude.cabal @@ -410,7 +410,7 @@ test-suite unittests hedgehog >= 1.0.3 && < 1.3, hint >= 0.7 && < 0.10, quickcheck-classes-base >= 0.6 && < 1.0, - tasty >= 1.2 && < 1.5, + tasty >= 1.2 && < 1.6, tasty-hedgehog >= 1.2.0, tasty-hunit, tasty-th, diff --git a/stack.yaml b/stack.yaml index fbfb3840d5..73f74d6c3d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,3 +14,7 @@ extra-deps: - ./clash-cosim - prettyprinter-interp-0.2.0.0@sha256:45299b61bd6c27d594c1a72b5a8dd5734e791a59828725e4f4e420f3cc37232b,2016 - infinite-list-0.1@sha256:4de250517ce75e128c766fbc1f23b5a778ea964e695e47f8e83e0f3b293091bf,2383 +- git: https://github.com/martijnbastiaan/tasty + commit: 48f4a4ab2cfdaabedf94c9aa455bf33d7bf36467 + subdirs: + - core diff --git a/tests/Main.hs b/tests/Main.hs index 31dea183f7..bf2d29fa91 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -110,8 +110,8 @@ clashTestRoot testTrees = clashTestGroup "." testTrees [] -- | `clashTestGroup` and `clashTestRoot` make sure that each test knows its --- fully qualified test name at construction time. This is used to create --- dependency patterns. +-- fully qualified test name at construction time. This is used to pass -i flags +-- to Clash as the test layout matches the layout in @shouldwork/@. clashTestGroup :: TestName -> [[TestName] -> TestTree] diff --git a/tests/src/Test/Tasty/Clash.hs b/tests/src/Test/Tasty/Clash.hs index fa52501d95..a56c3887ef 100644 --- a/tests/src/Test/Tasty/Clash.hs +++ b/tests/src/Test/Tasty/Clash.hs @@ -12,7 +12,6 @@ import Clash.Annotations.Primitive (HDL(..)) import Data.Coerce (coerce) import Data.Default (Default, def) import qualified Data.List as List -import Data.List (intercalate) import Data.Maybe (isJust) import qualified Data.Text as T import qualified System.Directory as Directory @@ -168,30 +167,6 @@ sourceDirectory = unsafePerformIO Directory.getCurrentDirectory {-# NOINLINE sourceDirectory #-} --- | Given a number of test trees, make sure each one of them is executed --- one after the other. To prevent naming collisions, parent group names can --- be included. Parent group names should be ordered outer -> inner. -sequenceTests - :: [TestName] - -- ^ Parent group names - -> [(TestName, TestTree)] - -- ^ Tests to sequence - -> [TestTree] -sequenceTests path (unzip -> (testNames, testTrees)) = - zipWith applyAfter testPatterns testTrees - where - -- Make pattern for a single test - pat :: TestName -> String - pat nm = "$0 ~ /" ++ intercalate "." (reverse (nm:path)) ++ "/" - - -- Test patterns for all given tests such that each executes sequentially - testPatterns = init (map (fmap pat) (Nothing : map Just testNames)) - - -- | Generate patterns given parent patterns and item patterns - applyAfter :: Maybe String -> TestTree -> TestTree - applyAfter Nothing tt = tt - applyAfter (Just p) tt = after AllSucceed p tt - targetTempPath :: IO FilePath -- ^ Parent temporary directory @@ -219,8 +194,8 @@ stepName tool step target = tool <> " (" <> step <> " " <> target <> ")" -- and one for running them. It depends on 'hdlLoad' and 'hdlSim' what will be -- executed. data TestTarget = TestTarget - { buildTests :: [(TestName, TestTree)] - , simTests :: [(TestName, TestTree)] + { buildTests :: [TestTree] + , simTests :: [TestTree] } data ClashGenTest = ClashGenTest @@ -329,13 +304,11 @@ ghdlTests opts@TestOptions{..} parentTmp = makeName = toolName "make" simName = toolName "sim" build t = - [ ( importName t - , singleTest (importName t) $ GhdlImportTest parentTmp (dir t)) - , ( makeName t - , singleTest (makeName t) $ GhdlMakeTest (dir t) t) + [ singleTest (importName t) $ GhdlImportTest parentTmp (dir t) + , singleTest (makeName t) $ GhdlMakeTest (dir t) t ] sim t = - [ (simName t, singleTest (simName t) $ GhdlSimTest expectSimFail (dir t) t) + [ singleTest (simName t) $ GhdlSimTest expectSimFail (dir t) t ] -- | Generate test trees for running Icarus Verilog @@ -354,13 +327,11 @@ iverilogTests opts@TestOptions{..} parentTmp = makeName = toolName "make" simName = toolName "sim" build t = - [ ( makeName t - , singleTest (makeName t) $ IVerilogMakeTest parentTmp (dir t) t) + [ singleTest (makeName t) $ IVerilogMakeTest parentTmp (dir t) t ] sim t = - [ ( simName t - , singleTest (simName t) $ - IVerilogSimTest expectSimFail vvpStdoutNonEmptyFail (dir t) t) + [ singleTest (simName t) $ + IVerilogSimTest expectSimFail vvpStdoutNonEmptyFail (dir t) t ] -- | Generate test trees for running ModelSim @@ -380,14 +351,11 @@ modelsimTests opts@TestOptions{..} parentTmp = vlogName = toolName "vlog" simName = toolName "sim" build t = - [ ( vlibName t - , singleTest (vlibName t) $ ModelsimVlibTest parentTmp (dir t)) - , ( vlogName t - , singleTest (vlogName t) $ ModelsimVlogTest (dir t)) + [ singleTest (vlibName t) $ ModelsimVlibTest parentTmp (dir t) + , singleTest (vlogName t) $ ModelsimVlogTest (dir t) ] sim t = - [ ( simName t - , singleTest (simName t) $ ModelsimSimTest expectSimFail (dir t) t) + [ singleTest (simName t) $ ModelsimSimTest expectSimFail (dir t) t ] -- | Generate test trees for running Verilator @@ -406,13 +374,11 @@ verilatorTests opts@TestOptions{..} parentTmp = makeName = toolName "make" simName = toolName "sim" build t = - [ ( makeName t - , singleTest (makeName t) $ VerilatorMakeTest parentTmp (dir t) t) + [ singleTest (makeName t) $ VerilatorMakeTest parentTmp (dir t) t ] sim t = - [ ( simName t - , singleTest (simName t) $ - VerilatorSimTest expectSimFail vvpStdoutNonEmptyFail (dir t) t) + [ singleTest (simName t) $ + VerilatorSimTest expectSimFail vvpStdoutNonEmptyFail (dir t) t ] -- | Generate a test tree for running Vivado. Depending on 'hdlSim' it will be @@ -430,25 +396,20 @@ vivadoTests opts parentTmp = dir = targetTempPath parentTmp "vivado" simName = stepName "vivado" "sim" sim t = - [ ( simName t - , singleTest (simName t) $ VivadoTest parentTmp (dir t) (T.pack t)) + [ singleTest (simName t) $ VivadoTest parentTmp (dir t) (T.pack t) ] -- | Generate a test tree for running SymbiYosys sbyTests :: TestOptions -> IO FilePath - -> [(TestName, TestTree)] + -> TestTree sbyTests opts@TestOptions {..} parentTmp = - [ ( sbyName t - , singleTest (sbyName t) $ - SbyVerificationTest expectVerificationFail parentTmp (dir t) t - ) - | t <- getBuildTargets opts - ] + testGroup "SymbiYosys" (map sbyTest (getBuildTargets opts)) where + sbyTest t = + singleTest t (SbyVerificationTest expectVerificationFail parentTmp (dir t) t) dir = targetTempPath parentTmp "symbiyosys" - sbyName t = "symbiyosys (" <> t <> ")" runTest1 :: String @@ -458,18 +419,16 @@ runTest1 -> TestTree runTest1 modName opts@TestOptions{..} path target = withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> - testGroup (show target) $ - sequenceIndependent (clashTest tmpDir) $ - (case verificationTool of - Nothing -> [] - Just SymbiYosys -> sbyTests opts tmpDir) - : hdlTests tmpDir + sequentialTestGroup (show target) AllSucceed + ( clashTest tmpDir + : verifTests tmpDir + : hdlTests tmpDir ) where mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (tail path)) clashTest tmpDir = - ("clash (gen)", singleTest "clash (gen)" (ClashGenTest { + singleTest "clash (gen)" (ClashGenTest { cgExpectFailure=expectClashFail , cgBuildTarget=target , cgSourceDirectory=sourceDir @@ -477,64 +436,40 @@ runTest1 modName opts@TestOptions{..} path target = , cgModName=modName , cgOutputDirectory=tmpDir , cgHdlDirectory=fmap ( "hdl") tmpDir - })) + }) - buildAndSimTests :: Sim -> [TestTarget] -> [[(TestName, TestTree)]] + emptyGroup = testGroup "empty" [] + + buildAndSimTests :: Sim -> [TestTarget] -> TestTree buildAndSimTests sim tests - | isJust expectClashFail = [] - | otherwise = flip map tests $ \TestTarget{..} -> - (if sim `elem` hdlLoad then buildTests else []) <> - (if sim `elem` hdlSim then simTests else []) - - -- HACK: We want to run simulators independently if multiple are going to be - -- run, otherwise failures from whichever comes first will mean the second is - -- skipped. In lieu of a better way to sequence tests we can sequence tests - -- for multiple simulators, then drop the first test tree for all but the - -- first simulator (as it will be copies of clash gen). - -- - -- TODO: Since tasty doesn't provide one, we should really provide a better - -- set of combinators for describing test dependencies. That way we can have - -- some more principled way of having a test structure like - -- - -- Group A - -- - Task A1 - -- - Group B - -- - Task B1 - -- - Task B2 - -- - Group C - -- - Task C1 - -- - -- where groups B and C are independent of each other, but both dependent on - -- the success of Task A1. - sequenceIndependent - :: (TestName, TestTree) - -- ^ The tree everything else depends on ("clash (gen)") - -> [[(TestName, TestTree)]] - -- ^ All the independent trees to run after "clash (gen)" - -> [TestTree] - sequenceIndependent gen = go - where - go [] = sequenceOne [] - go (l:ls) = sequenceOne l <> concatMap (tail . sequenceOne) ls - sequenceOne ts = sequenceTests (show target : path) (gen : ts) + | isJust expectClashFail = testGroup "" [] + | otherwise = sequentialTestGroup (show sim) AllSucceed $ + flip concatMap tests $ \TestTarget{..} -> + (if sim `elem` hdlLoad then buildTests else []) <> + (if sim `elem` hdlSim then simTests else []) -- | The tests that are switched by `hdlLoad` and `hdlSim` hdlTests tmpDir = case target of - VHDL -> concat + VHDL -> [ buildAndSimTests GHDL (ghdlTests opts tmpDir) , buildAndSimTests Vivado (vivadoTests opts tmpDir) ] - Verilog -> concat + Verilog -> [ buildAndSimTests IVerilog (iverilogTests opts tmpDir) , buildAndSimTests Verilator (verilatorTests opts tmpDir) , buildAndSimTests Vivado (vivadoTests opts tmpDir) ] - SystemVerilog -> concat + SystemVerilog -> [ -- TODO: ModelSim can do VHDL and Verilog too. Add that? buildAndSimTests ModelSim (modelsimTests opts tmpDir) , buildAndSimTests Verilator (verilatorTests opts tmpDir) ] + verifTests tmpDir = + case verificationTool of + Nothing -> emptyGroup + Just SymbiYosys -> sbyTests opts tmpDir + runTest :: String -- ^ Name of test @@ -563,7 +498,7 @@ outputTest' -> TestTree outputTest' modName target extraClashArgs extraGhcArgs path = withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> - testGroup (show target) $ sequenceTests (show target : path) $ + sequentialTestGroup (show target) AllSucceed [ clashGenHdl tmpDir , clashBuild tmpDir ] @@ -571,7 +506,7 @@ outputTest' modName target extraClashArgs extraGhcArgs path = mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (tail path)) - clashGenHdl workDir = ("clash (gen)", singleTest "clash (gen)" (ClashGenTest { + clashGenHdl workDir = singleTest "clash (gen)" (ClashGenTest { cgExpectFailure=Nothing , cgBuildTarget=target , cgSourceDirectory=sourceDir @@ -579,16 +514,16 @@ outputTest' modName target extraClashArgs extraGhcArgs path = , cgModName=modName , cgOutputDirectory=workDir , cgHdlDirectory=workDir - })) + }) - clashBuild workDir = ("clash (exec)", singleTest "clash (exec)" (ClashBinaryTest { + clashBuild workDir = singleTest "clash (exec)" (ClashBinaryTest { cbBuildTarget=target , cbSourceDirectory=sourceDir , cbExtraBuildArgs="-DOUTPUTTEST" : extraGhcArgs , cbExtraExecArgs=[] , cbModName=modName , cbOutputDirectory=workDir - })) + }) outputTest :: String @@ -620,14 +555,14 @@ clashLibTest' -> TestTree clashLibTest' modName target extraGhcArgs path = withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> - testGroup (show target) $ sequenceTests (show target : path) $ + sequentialTestGroup (show target) AllSucceed [ clashBuild tmpDir ] where mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (tail path)) - clashBuild workDir = ("clash (exec)", singleTest "clash (exec)" (ClashBinaryTest { + clashBuild workDir = singleTest "clash (exec)" (ClashBinaryTest { cbBuildTarget=target , cbSourceDirectory=sourceDir , cbExtraBuildArgs="-DCLASHLIBTEST" : @@ -638,7 +573,7 @@ clashLibTest' modName target extraGhcArgs path = , cbExtraExecArgs=[] , cbModName=modName , cbOutputDirectory=workDir - })) + }) clashLibTest :: String @@ -653,7 +588,7 @@ clashLibTest modName opts path = -- HACK: clashLibTests are run sequentially to prevent race issues. See: -- HACK: https://github.com/clash-lang/clash-compiler/pull/1416 let testName = modName ++ " [clash-lib test]" - in testGroup testName $ sequenceTests (testName:path) - [ (show target, clashLibTest' modName target (ghcFlags opts) (testName:path)) + in sequentialTestGroup testName AllFinish + [ clashLibTest' modName target (ghcFlags opts) (testName:path) | target <- hdlTargets opts ]