diff --git a/changelog/2023-10-02T15_07_39+02_00_remove_KnownDomain-preparation b/changelog/2023-10-02T15_07_39+02_00_remove_KnownDomain-preparation new file mode 100644 index 0000000000..6427ebf5b0 --- /dev/null +++ b/changelog/2023-10-02T15_07_39+02_00_remove_KnownDomain-preparation @@ -0,0 +1,5 @@ +ADDED: You can now use ~PERIOD, ~ISSYNC, ~ISINITDEFINED and ~ACTIVEEDGE +on arguments of type Clock,Reset,Enable,ClockN and DiffClock. + +CHANGED: unsafeToReset and invertReset now have a KnownDomain constraint +This was done in preparation for [Remove KnownDomain #2589](https://github.com/clash-lang/clash-compiler/pull/2589) diff --git a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs index ce55a2ee51..3dc55cceb1 100644 --- a/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs +++ b/clash-cores/src/Clash/Cores/Xilinx/DcFifo/Internal/BlackBoxes.hs @@ -178,7 +178,7 @@ dcFifoBBTF DcConfig{..} bbCtx let domty = DSL.ety knownDomainWrite in case stripVoid domty of N.KnownDomain _ _ _ Synchronous _ _ -> - DSL.unsafeToActiveHigh "wr_rst_high" domty wRst + DSL.unsafeToActiveHigh "wr_rst_high" wRst N.KnownDomain _ _ _ Asynchronous _ _ -> error $ show 'dcFifoTF <> ": dcFifo only supports synchronous resets" @@ -190,7 +190,7 @@ dcFifoBBTF DcConfig{..} bbCtx let domty = DSL.ety knownDomainRead in case stripVoid domty of N.KnownDomain _ _ _ Synchronous _ _ -> - DSL.unsafeToActiveHigh "rd_rst_high" domty rRst + DSL.unsafeToActiveHigh "rd_rst_high" rRst N.KnownDomain _ _ _ Asynchronous _ _ -> error $ show 'dcFifoTF <> ": dcFifo only supports synchronous resets" diff --git a/clash-lib/clash-lib.cabal b/clash-lib/clash-lib.cabal index f4cfe61029..4dd65dc521 100644 --- a/clash-lib/clash-lib.cabal +++ b/clash-lib/clash-lib.cabal @@ -359,7 +359,6 @@ executable static-files docopt ^>= 0.7, extra, filepath - Other-Modules: Paths_clash_lib GHC-Options: -Wall -Wcompat default-language: Haskell2010 if impl(ghc >= 9.2.0) diff --git a/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml index e84cc2c0b7..2a2244544d 100644 --- a/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/commonverilog/Clash_Signal_Internal.primitives.yaml @@ -9,6 +9,6 @@ name: Clash.Signal.Internal.unsafeToReset kind: Expression type: 'unsafeToReset :: - Signal dom Bool -> Reset dom' - template: ~ARG[0] + KnownDomain dom => Signal dom Bool -> Reset dom' + template: ~ARG[1] workInfo: Never diff --git a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml index afd0e89e36..6de077240e 100644 --- a/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml +++ b/clash-lib/prims/vhdl/Clash_Signal_Internal.primitives.yaml @@ -230,6 +230,6 @@ name: Clash.Signal.Internal.unsafeToReset kind: Declaration type: 'unsafeToReset :: - Signal dom Bool -> Reset dom' - template: ~RESULT <= '1' when ~ARG[0] = true else '0'; + KnownDomain dom => Signal dom Bool -> Reset dom' + template: ~RESULT <= '1' when ~ARG[1] = true else '0'; workInfo: Never diff --git a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs index c79b4ddf2e..0089d181ed 100644 --- a/clash-lib/src/Clash/Netlist/BlackBox/Util.hs +++ b/clash-lib/src/Clash/Netlist/BlackBox/Util.hs @@ -57,7 +57,7 @@ import Text.Read (readEither) import Text.Trifecta.Result hiding (Err) import Clash.Backend - (Backend (..), Usage (..), AggressiveXOptBB(..), RenderEnums(..)) + (Backend (..), DomainMap, Usage (..), AggressiveXOptBB(..), RenderEnums(..)) import Clash.Netlist.BlackBox.Parser import Clash.Netlist.BlackBox.Types import Clash.Netlist.Types @@ -65,7 +65,7 @@ import Clash.Netlist.Types Declaration(BlackBoxD)) import qualified Clash.Netlist.Id as Id import qualified Clash.Netlist.Types as N -import Clash.Netlist.Util (typeSize, isVoid, stripVoid) +import Clash.Netlist.Util (typeSize, isVoid, stripAttributes, stripVoid) import Clash.Signal.Internal (ResetKind(..), ResetPolarity(..), InitBehavior(..), VDomainConfiguration (..)) import Clash.Util @@ -185,10 +185,11 @@ verifyBlackBoxContext bbCtx (N.BBTemplate t) = Just n -> case indexMaybe (bbInputs bbCtx) n of Just _ -> Nothing - Nothing -> - Just ( "Blackbox required at least " ++ show (n+1) - ++ " arguments, but only " ++ show (length (bbInputs bbCtx)) - ++ " were passed." ) + Nothing -> do + let str = fromJust (fmap Text.unpack (getAp $ prettyElem e)) + Just ( "Blackbox used \"" ++ str ++ "\"" + ++ ", but only " ++ show (length (bbInputs bbCtx)) + ++ " arguments were passed." ) extractLiterals :: BlackBoxContext -> [Expr] @@ -492,20 +493,20 @@ renderElem b (IF c t f) = do syn <- hdlSyn enums <- renderEnums xOpt <- aggressiveXOptBB - let c' = check (coerce xOpt) iw hdl syn enums c + c' <- check (coerce xOpt) iw hdl syn enums c if c' > 0 then renderTemplate b t else renderTemplate b f where - check :: Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element -> Int + check :: Backend backend => Bool -> Int -> HDL -> HdlSyn -> RenderEnums -> Element -> State backend Int check xOpt iw hdl syn enums c' = case c' of - (Size e) -> typeSize (lineToType b [e]) - (Length e) -> case lineToType b [e] of + (Size e) -> pure $ typeSize (lineToType b [e]) + (Length e) -> pure $ case lineToType b [e] of (Vector n _) -> n Void (Just (Vector n _)) -> n (MemBlob n _) -> n Void (Just (MemBlob n _)) -> n _ -> 0 -- HACK: So we can test in splitAt if one of the -- vectors in the tuple had a zero length - (Lit n) -> case bbInputs b !! n of + (Lit n) -> pure $ case bbInputs b !! n of (l,_,_) | Literal _ l' <- l -> case l' of @@ -533,16 +534,16 @@ renderElem b (IF c t f) = do , [Literal _ (NumLit j)] <- extractLiterals bbCtx -> fromInteger j k -> error $ $(curLoc) ++ ("IF: LIT must be a numeric lit:" ++ show k) - (Depth e) -> case lineToType b [e] of + (Depth e) -> pure $ case lineToType b [e] of (RTree n _) -> n _ -> error $ $(curLoc) ++ "IF: treedepth of non-tree type" - IW64 -> if iw == 64 then 1 else 0 - (HdlSyn s) -> if s == syn then 1 else 0 - (IsVar n) -> let (e,_,_) = bbInputs b !! n + IW64 -> pure $ if iw == 64 then 1 else 0 + (HdlSyn s) -> pure $ if s == syn then 1 else 0 + (IsVar n) -> pure $ let (e,_,_) = bbInputs b !! n in case e of Identifier _ Nothing -> 1 _ -> 0 - (IsLit n) -> let (e,_,_) = bbInputs b !! n + (IsLit n) -> pure $ let (e,_,_) = bbInputs b !! n in case e of DataCon {} -> 1 Literal {} -> 1 @@ -556,13 +557,13 @@ renderElem b (IF c t f) = do RenderEnums True -> 1 RenderEnums False -> 0 isScalar _ _ = 0 - in isScalar hdl ty + in pure $ isScalar hdl ty - (IsUndefined n) -> + (IsUndefined n) -> pure $ let (e, _, _) = bbInputs b !! n in if xOpt && checkUndefined e then 1 else 0 - (IsActiveEnable n) -> + (IsActiveEnable n) -> pure $ let (e, ty, _) = bbInputs b !! n in case ty of Enable _ -> @@ -584,52 +585,81 @@ renderElem b (IF c t f) = do _ -> error $ $(curLoc) ++ "IsActiveEnable: Expected Bool or Enable, not: " ++ show ty - (ActiveEdge edgeRequested n) -> - let (_, ty, _) = bbInputs b !! n in - case stripVoid ty of - KnownDomain _ _ edgeActual _ _ _ -> + (ActiveEdge edgeRequested n) -> do + let (_, ty, _) = bbInputs b !! n + domConf <- getDomainConf ty + case domConf of + VDomainConfiguration _ _ edgeActual _ _ _ -> pure $ if edgeRequested == edgeActual then 1 else 0 - _ -> - error $ $(curLoc) ++ "ActiveEdge: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty - - (IsSync n) -> - let (_, ty, _) = bbInputs b !! n in - case stripVoid ty of - KnownDomain _ _ _ Synchronous _ _ -> 1 - KnownDomain _ _ _ Asynchronous _ _ -> 0 - _ -> error $ $(curLoc) ++ "IsSync: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty - - (IsInitDefined n) -> - let (_, ty, _) = bbInputs b !! n in - case stripVoid ty of - KnownDomain _ _ _ _ Defined _ -> 1 - KnownDomain _ _ _ _ Unknown _ -> 0 - _ -> error $ $(curLoc) ++ "IsInitDefined: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty - - (IsActiveHigh n) -> - let (_, ty, _) = bbInputs b !! n in - case stripVoid ty of - KnownDomain _ _ _ _ _ ActiveHigh -> 1 - KnownDomain _ _ _ _ _ ActiveLow -> 0 - _ -> error $ $(curLoc) ++ "IsActiveHigh: Expected `KnownDomain` or `KnownConfiguration`, not: " ++ show ty - - (StrCmp [Text t1] n) -> + + (IsSync n) -> do + let (_, ty, _) = bbInputs b !! n + domConf <- getDomainConf ty + case domConf of + VDomainConfiguration _ _ _ Synchronous _ _ -> pure 1 + VDomainConfiguration _ _ _ Asynchronous _ _ -> pure 0 + + (IsInitDefined n) -> do + let (_, ty, _) = bbInputs b !! n + domConf <- getDomainConf ty + case domConf of + VDomainConfiguration _ _ _ _ Defined _ -> pure 1 + VDomainConfiguration _ _ _ _ Unknown _ -> pure 0 + + (IsActiveHigh n) -> do + let (_, ty, _) = bbInputs b !! n + domConf <- getDomainConf ty + case domConf of + VDomainConfiguration _ _ _ _ _ ActiveHigh -> pure 1 + VDomainConfiguration _ _ _ _ _ ActiveLow -> pure 0 + + (StrCmp [Text t1] n) -> pure $ let (e,_,_) = bbInputs b !! n in case exprToString e of Just t2 | t1 == Text.pack t2 -> 1 | otherwise -> 0 Nothing -> error $ $(curLoc) ++ "Expected a string literal: " ++ show e - (And es) -> if all (/=0) (map (check xOpt iw hdl syn enums) es) + (And es) -> do + es' <- mapM (check xOpt iw hdl syn enums) es + pure $ if all (/=0) es' then 1 else 0 - CmpLE e1 e2 -> if check xOpt iw hdl syn enums e1 <= check xOpt iw hdl syn enums e2 - then 1 - else 0 + CmpLE e1 e2 -> do + v1 <- check xOpt iw hdl syn enums e1 + v2 <- check xOpt iw hdl syn enums e2 + if v1 <= v2 + then pure 1 + else pure 0 _ -> error $ $(curLoc) ++ "IF: condition must be: SIZE, LENGTH, LIT, DEPTH, IW64, VIVADO, OTHERSYN, ISVAR, ISLIT, ISUNDEFINED, ISACTIVEENABLE, ACTIVEEDGE, ISSYNC, ISINITDEFINED, ISACTIVEHIGH, STRCMP, AND, ISSCALAR or CMPLE." ++ "\nGot: " ++ show c' renderElem b e = fmap const (renderTag b e) +getDomainConf :: (Backend backend, HasCallStack) => HWType -> State backend VDomainConfiguration +getDomainConf = generalGetDomainConf domainConfigurations + +generalGetDomainConf + :: forall m. (Monad m, HasCallStack) + => (m DomainMap) -- ^ a way to get the `DomainMap` + -> HWType -> m VDomainConfiguration +generalGetDomainConf getDomainMap ty = case (snd . stripAttributes . stripVoid) ty of + KnownDomain dom period activeEdge resetKind initBehavior resetPolarity -> + pure $ VDomainConfiguration (Data.Text.unpack dom) (fromIntegral period) activeEdge resetKind initBehavior resetPolarity + + Clock dom -> go dom + ClockN dom -> go dom + Reset dom -> go dom + Enable dom -> go dom + Product _DiffClock _ [Clock dom,_clkN] -> go dom + t -> error $ "Don't know how to get a Domain out of HWType: " <> show t + where + go :: HasCallStack => N.DomainName -> m VDomainConfiguration + go dom = do + doms <- getDomainMap + case HashMap.lookup dom doms of + Nothing -> error $ "Can't find domain " <> show dom <> ". Please report an issue at https://github.com/clash-lang/clash-compiler/issues." + Just conf -> pure conf + parseFail :: Text -> BlackBoxTemplate parseFail t = case runParse t of Failure errInfo -> diff --git a/clash-lib/src/Clash/Primitives/DSL.hs b/clash-lib/src/Clash/Primitives/DSL.hs index b33199d076..30d795f170 100644 --- a/clash-lib/src/Clash/Primitives/DSL.hs +++ b/clash-lib/src/Clash/Primitives/DSL.hs @@ -118,8 +118,8 @@ import Clash.Annotations.Primitive (HDL (..), Primitive (..)) import Clash.Annotations.SynthesisAttributes (Attr) import Clash.Backend hiding (Usage, fromBV, toBV) import Clash.Backend.VHDL (VHDLState) -import Clash.Explicit.Signal (ResetPolarity(..)) -import Clash.Netlist.BlackBox.Util (exprToString, renderElem) +import Clash.Explicit.Signal (ResetPolarity(..), vResetPolarity) +import Clash.Netlist.BlackBox.Util (exprToString, getDomainConf, renderElem) import Clash.Netlist.BlackBox.Types (BlackBoxTemplate, Element(Component, Text), Decl(..)) import qualified Clash.Netlist.Id as Id @@ -204,6 +204,17 @@ instance Backend backend => HasIdentifierSet (BlockState backend) where instance HasUsageMap backend => HasUsageMap (BlockState backend) where usageMap = bsBackend.usageMap +liftToBlockState + :: forall backend a. Backend backend + => State backend a -> State (BlockState backend) a +liftToBlockState (StateT f) = StateT g + where + g :: BlockState backend -> Identity (a, BlockState backend) + g sbsIn = do + let sIn = _bsBackend sbsIn + (res,sOut) <- f sIn + pure (res, sbsIn{_bsBackend = sOut}) + -- | A typed expression. data TExpr = TExpr { ety :: HWType @@ -1012,32 +1023,26 @@ unsafeToActiveHigh :: Backend backend => Text -- ^ Name hint - -> HWType - -- ^ 'KnownDomain' -> TExpr -- ^ Reset signal -> State (BlockState backend) TExpr -unsafeToActiveHigh nm dom rExpr = - case extrResetPolarity dom of +unsafeToActiveHigh nm rExpr = do + resetLevel <- vResetPolarity <$> liftToBlockState (getDomainConf (ety rExpr)) + case resetLevel of ActiveHigh -> pure rExpr ActiveLow -> notExpr nm rExpr -extrResetPolarity :: HWType -> ResetPolarity -extrResetPolarity (Void (Just (KnownDomain _ _ _ _ _ p))) = p -extrResetPolarity p = error ("Internal error: expected KnownDomain, got: " <> show p) - -- | Massage a reset to work as active-low reset. unsafeToActiveLow :: Backend backend => Text -- ^ Name hint - -> HWType - -- ^ 'KnownDomain' -> TExpr -- ^ Reset signal -> State (BlockState backend) TExpr -unsafeToActiveLow nm dom rExpr = - case extrResetPolarity dom of +unsafeToActiveLow nm rExpr = do + resetLevel <- vResetPolarity <$> liftToBlockState (getDomainConf (ety rExpr)) + case resetLevel of ActiveLow -> pure rExpr ActiveHigh -> notExpr nm rExpr diff --git a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs index be1abdc4ad..92c5831a8a 100644 --- a/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Intel/ClockGen.hs @@ -36,9 +36,9 @@ import qualified Prettyprinter.Interpolate as I data Variant = Altpll | AlteraPll hdlUsed :: [Int] -hdlUsed = [ knownDomIn, clk, rst ] +hdlUsed = [ clk, rst ] where - knownDomIn + _knownDomIn :< _clocksClass :< _clocksCxt :< _numOutClocks @@ -81,7 +81,7 @@ hdlTemplate :: BlackBoxContext -> State s Doc hdlTemplate variant bbCtx - | [ knownDomIn + | [ _knownDomIn , _clocksClass , _clocksCxt , _numOutClocks @@ -110,7 +110,7 @@ hdlTemplate variant bbCtx DSL.declarationReturn bbCtx (stdName variant <> "_block") $ do - rstHigh <- DSL.unsafeToActiveHigh "reset" (DSL.ety knownDomIn) rst + rstHigh <- DSL.unsafeToActiveHigh "reset" rst pllOuts <- DSL.declareN "pllOut" pllOutTys locked <- DSL.declare "locked" Bit pllLock <- DSL.boolFromBit "pllLock" locked diff --git a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs index 5817a35892..5763a14c76 100644 --- a/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs +++ b/clash-lib/src/Clash/Primitives/Xilinx/ClockGen.hs @@ -65,7 +65,7 @@ clockWizardTemplate -> BlackBoxContext -> State s Doc clockWizardTemplate isDifferential bbCtx - | [ knownDomIn + | [ _knownDomIn , _clocksClass , _clocksCxt , _numOutClocks @@ -79,7 +79,7 @@ clockWizardTemplate isDifferential bbCtx clkWizInstName <- Id.makeBasic $ fromMaybe "clk_wiz" $ bbCtxName bbCtx DSL.declarationReturn bbCtx blockName $ do - rstHigh <- DSL.unsafeToActiveHigh "reset" (DSL.ety knownDomIn) rst + rstHigh <- DSL.unsafeToActiveHigh "reset" rst pllOuts <- DSL.declareN "pllOut" pllOutTys locked <- DSL.declare "locked" Bit pllLock <- DSL.boolFromBit "pllLock" locked diff --git a/clash-prelude/src/Clash/Signal/Internal.hs b/clash-prelude/src/Clash/Signal/Internal.hs index 3101d37bdf..868ce8f632 100644 --- a/clash-prelude/src/Clash/Signal/Internal.hs +++ b/clash-prelude/src/Clash/Signal/Internal.hs @@ -1279,7 +1279,8 @@ unsafeFromReset (Reset r) = r -- __NB__: You probably want to use 'unsafeFromActiveLow' or -- 'unsafeFromActiveHigh'. unsafeToReset - :: Signal dom Bool + :: KnownDomain dom + => Signal dom Bool -> Reset dom unsafeToReset r = Reset r -- See: https://github.com/clash-lang/clash-compiler/pull/2511 @@ -1359,7 +1360,7 @@ unsafeFromActiveLow r = SActiveLow -> r -- | Invert reset signal -invertReset :: Reset dom -> Reset dom +invertReset :: KnownDomain dom => Reset dom -> Reset dom invertReset = unsafeToReset . fmap not . unsafeFromReset infixr 2 .||. diff --git a/clash-prelude/src/Clash/Tutorial.hs b/clash-prelude/src/Clash/Tutorial.hs index 3dbbdb8f74..e4cafa318f 100644 --- a/clash-prelude/src/Clash/Tutorial.hs +++ b/clash-prelude/src/Clash/Tutorial.hs @@ -1290,16 +1290,16 @@ a general listing of the available template holes: * @~TAG[N]@: Name of given domain. Errors when called on an argument which is not a 'KnownDomain', 'Reset', or 'Clock'. * @~PERIOD[N]@: Clock period of given domain. Errors when called on an argument - which is not a 'KnownDomain' or 'KnownConf'. + which is not a 'Clock', 'Reset', 'KnownDomain' or 'KnownConf'. * @~ISACTIVEENABLE[N]@: Is the @(N+1)@'th argument a an Enable line NOT set to a constant True. Can be used instead of deprecated (and removed) template tag * @~ISSYNC[N]@: Does synthesis domain at the @(N+1)@'th argument have synchronous resets. Errors - when called on an argument which is not a 'KnownDomain' or 'KnownConf'. + when called on an argument which is not a 'Reset', 'Clock', 'Enable', 'KnownDomain' or 'KnownConf'. * @~ISINITDEFINED[N]@: Does synthesis domain at the @(N+1)@'th argument have defined initial - values. Errors when called on an argument which is not a 'KnownDomain' or 'KnownConf'. + values. Errors when called on an argument which is not a 'Clock', 'Reset', 'Enable', 'KnownDomain' or 'KnownConf'. * @~ACTIVEEDGE[edge][N]@: Does synthesis domain at the @(N+1)@'th argument respond to /edge/. /edge/ must be one of 'Falling' or 'Rising'. Errors when called on an - argument which is not a 'KnownDomain' or 'KnownConf'. + argument which is not a 'Clock', 'Reset', 'Enable', 'KnownDomain' or 'KnownConf'. * @~AND[\,\,..]@: Logically /and/ the conditions in the @\@'s * @~VAR[\][N]@: Like @~ARG[N]@ but binds the argument to a variable named NAME. The @\@ can be left blank, then clash will come up with a (unique) name. diff --git a/tests/src/Test/Tasty/Clash.hs b/tests/src/Test/Tasty/Clash.hs index 768f430152..b3ca4a2a61 100644 --- a/tests/src/Test/Tasty/Clash.hs +++ b/tests/src/Test/Tasty/Clash.hs @@ -412,6 +412,9 @@ sbyTests opts@TestOptions {..} parentTmp = singleTest t (SbyVerificationTest expectVerificationFail parentTmp (dir t) t) dir = targetTempPath parentTmp "symbiyosys" +rmTmpDir :: FilePath -> IO () +rmTmpDir = Directory.removeDirectoryRecursive + runTest1 :: String -> TestOptions @@ -419,13 +422,13 @@ runTest1 -> HDL -> TestTree runTest1 modName opts@TestOptions{..} path target = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashTest tmpDir , testGroup "tools" (verifTests tmpDir : hdlTests tmpDir) ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashTest tmpDir = @@ -499,13 +502,13 @@ outputTest' -- one closest to the test. -> TestTree outputTest' modName target extraClashArgs extraGhcArgs path = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashGenHdl tmpDir , clashBuild tmpDir ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashGenHdl workDir = singleTest "clash (gen)" (ClashGenTest { @@ -556,12 +559,12 @@ clashLibTest' -- one closest to the test. -> TestTree clashLibTest' modName target extraGhcArgs path = - withResource mkTmpDir Directory.removeDirectoryRecursive $ \tmpDir -> + withResource mkTmpDir rmTmpDir $ \tmpDir -> sequentialTestGroup (show target) AllSucceed [ clashBuild tmpDir ] where - mkTmpDir = flip createTempDirectory "clash-test" =<< getCanonicalTemporaryDirectory + mkTmpDir = flip createTempDirectory ("clash-test_" <> modName) =<< getCanonicalTemporaryDirectory sourceDir = List.foldl' () sourceDirectory (reverse (drop 1 path)) clashBuild workDir = singleTest "clash (exec)" (ClashBinaryTest {