Skip to content

Commit ad42dc5

Browse files
kleinreactkleinreact
committed
Hedgehog Integration (WIP)
1 parent cb513f9 commit ad42dc5

File tree

11 files changed

+375
-200
lines changed

11 files changed

+375
-200
lines changed

‎clash-testbench/clash-testbench.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ library
4343
Clash.Testbench.Internal.ID
4444
Clash.Testbench.Internal.Signal
4545
Clash.Testbench.Internal.Monad
46+
Control.Monad.Extra
4647
build-depends:
4748
base,
4849
mtl,

‎clash-testbench/example/Main.hs

Lines changed: 58 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,28 @@
11
{-# LANGUAGE RecursiveDo #-}
22
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE TypeFamilies #-}
4+
{-# LANGUAGE OverloadedStrings #-}
35
module Main where
46

57
import Data.Bool (bool)
68

7-
import Clash.Prelude (Signed)
9+
import Clash.Prelude (Signal, Clock, Reset, Enable, Signed, System, exposeClockResetEnable, register, bundle, unsafeFromReset, hasReset, fromEnable, hasEnable)
810

911
import Clash.Testbench
1012

1113
import Calculator (OPC(..))
12-
import qualified Calculator (topEntity)
14+
--import qualified Calculator (topEntity)
15+
import qualified Register (topEntity)
16+
import qualified RegisterFail (topEntity)
1317

18+
import Control.Monad (void)
19+
import Control.Monad.IO.Class
1420
import Clash.Hedgehog.Sized.Signed
1521
import Hedgehog
1622
import qualified Hedgehog.Gen as Gen
1723
import qualified Hedgehog.Range as Range
1824

25+
{-
1926
genIO :: Gen [(OPC (Signed 4), Maybe (Signed 4))]
2027
genIO = do
2128
-- generate 7 constants
@@ -43,17 +50,62 @@ genIO = do
4350
myTestbench
4451
:: TB ()
4552
myTestbench = mdo
46-
-- input <- fromList Pop [Imm 1, Push, Imm 2, Push, Pop, Pop, Pop, ADD]
47-
input <- matchIOGenN output genIO
53+
input <- fromList Pop [Imm 1, Push, Imm 2, Push, Pop, Pop, Pop, ADD]
54+
-- input <- matchIOGenN output genIO
4855
output <- ("topEntity" @@ Calculator.topEntity) auto auto auto input
4956
watch input
5057
watch output
58+
-}
59+
60+
rstenb
61+
:: Clock System
62+
-> Reset System
63+
-> Enable System
64+
-> Signal System (Bool, Bool)
65+
rstenb = exposeClockResetEnable
66+
$ bundle (unsafeFromReset hasReset, fromEnable hasEnable)
67+
68+
myTestbench
69+
:: TB ()
70+
myTestbench = mdo
71+
input <- matchIOGenN output $ do
72+
cs <- Gen.list (Range.singleton 7) (genSigned Range.constantBounded)
73+
return $ ((0,0) :) $ zip cs $ 0 : cs
74+
output <- ("topEntity" @@ Register.topEntity) auto auto auto input
75+
-- x <- ("rstenb" @@ rstenb) auto auto auto
76+
-- watch x
77+
watch input
78+
watch output
79+
80+
myTestbenchFail
81+
:: TB ()
82+
myTestbenchFail = mdo
83+
input <- matchIOGenN output $ do
84+
cs <- Gen.list (Range.singleton 7) (genSigned Range.constantBounded)
85+
return $ ((0,0) :) $ zip cs $ 0 : cs
86+
output <- ("topEntity" @@ RegisterFail.topEntity) auto auto auto input
87+
-- x <- ("rstenb" @@ rstenb) auto auto auto
88+
-- watch x
89+
watch input
90+
watch output
91+
5192

5293
main :: IO ()
53-
main = simulate 38 myTestbench
94+
main =
95+
-- simulate 10 myTestbench
96+
void $ checkParallel $ Group "Default"
97+
[ ("'successful test'", withTests 1 $ tbProperty myTestbench)
98+
, ("'failing test'", withTests 1 $ tbProperty myTestbenchFail)
99+
]
54100

55101
foreign export ccall "clash_ffi_main"
56102
ffiMain :: IO ()
57103

58104
ffiMain :: IO ()
59-
ffiMain = simulateFFI 38 myTestbench
105+
ffiMain = do
106+
-- simulateFFI (SimSettings False False) myTestbench
107+
sync <- ffiHedgehog
108+
ffiCheckGroup sync $ Group "Default"
109+
[ ("'successful test'", withTests 1 $ (tbPropertyFFI sync) myTestbench)
110+
-- [ ("'failing test'", withTests 1 $ (tbPropertyFFI sync) myTestbenchFail)
111+
]

‎clash-testbench/example/Register.hs

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
{-# LANGUAGE DataKinds #-}
2+
module Register where
3+
4+
import Clash.Prelude
5+
6+
topEntity
7+
:: Clock System
8+
-> Reset System
9+
-> Enable System
10+
-> Signal System (Signed 4)
11+
-> Signal System (Signed 4)
12+
13+
topEntity = exposeClockResetEnable reg
14+
where
15+
reg i = register 0 i

‎clash-testbench/example/RegisterFail.hs

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
{-# LANGUAGE DataKinds #-}
2+
module RegisterFail where
3+
4+
import Clash.Prelude
5+
6+
topEntity
7+
:: Clock System
8+
-> Reset System
9+
-> Enable System
10+
-> Signal System (Signed 4)
11+
-> Signal System (Signed 4)
12+
13+
topEntity = exposeClockResetEnable regFail
14+
where
15+
reg i = register 0 i
16+
17+
count ::
18+
HiddenClockResetEnable dom =>
19+
Signal dom (Signed 3)
20+
count =
21+
register 0 ((+1) <$> count)
22+
23+
regFail ::
24+
HiddenClockResetEnable dom =>
25+
Signal dom (Signed 4) ->
26+
Signal dom (Signed 4)
27+
28+
regFail =
29+
mux ((== 4) <$> count) 0 . reg
30+
31+

‎clash-testbench/example/cabal.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
11
packages: . .. ../../clash-ghc ../../clash-lib ../../clash-prelude ../../clash-ffi ../../clash-prelude-hedgehog
22

33
write-ghc-environment-files: always
4+
5+
--package *
6+
-- ghc-options: -fPIC -shared

‎clash-testbench/example/clash-testbench-example.cabal

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ category: Hardware
1414
common basic-config
1515
default-language: Haskell2010
1616
ghc-options:
17-
-Wall -Wcompat
17+
-Wall -Wcompat -threaded
1818
-fplugin GHC.TypeLits.Extra.Solver
1919
-fplugin GHC.TypeLits.Normalise
2020
-fplugin GHC.TypeLits.KnownNat.Solver
@@ -39,13 +39,19 @@ executable simulate
3939
import: basic-config
4040
main-is: Main.hs
4141
other-modules: Calculator
42+
Register
43+
RegisterFail
4244
-- this option is required, since clash-ffi and clash-testbench come
4345
-- with unresovled symbols for the VPI interface
4446
ghc-options: -optl -Wl,--unresolved-symbols=ignore-in-object-files
4547

48+
4649
foreign-library simulate-ffi
4750
import: basic-config
4851
other-modules: Main
4952
Calculator
53+
Register
54+
RegisterFail
5055
type: native-shared
56+
-- options: standalone
5157
lib-version-info: 0:1:0

‎clash-testbench/example/run-iverilog.sh

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,9 +26,11 @@ VVP=vvp
2626

2727
${CABAL} build clash-testbench-example || exit $?
2828
${CLASH} --verilog Calculator.hs || exit $?
29-
${IVERILOG} verilog/Calculator.topEntity/topEntity.v -o Calculator.vvp \
29+
${CLASH} --verilog Register.hs || exit $?
30+
${CLASH} --verilog RegisterFail.hs || exit $?
31+
${IVERILOG} verilog/Register.topEntity/topEntity.v -o Register.vvp \
3032
|| exit $?
3133
echo ""
3234
echo "Running Icarus Verilog VVP runtime engine:"
3335
echo ""
34-
${VVP} -Mlib -mlibsimulate-ffi Calculator.vvp
36+
${VVP} -Mlib -mlibsimulate-ffi Register.vvp

‎clash-testbench/src/Clash/Testbench/Generate.hs

Lines changed: 49 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Clash.Testbench.Generate where
1212

1313
import Hedgehog
1414
import Hedgehog.Gen
15+
import Control.Monad.Extra ((<?>), (<:>))
1516
import Control.Monad.IO.Class (MonadIO)
1617
import Control.Monad.State.Lazy (liftIO, when, modify)
1718
import Data.IORef (newIORef, readIORef, writeIORef)
@@ -33,24 +34,21 @@ generate gen = do
3334
TBDomain{..} <- tbDomain @dom
3435

3536
vRef <- liftIO $ newIORef undefined
36-
checkForProgress <- progressCheck simStepRef True
37+
ifProgress <- progressCheck simStepRef True
3738
signalHistory <- newHistory
3839

3940
mind SomeSignal IOInput
4041
{ signalId = NoID
41-
, signalCurVal = const $ do
42-
progress <- checkForProgress
43-
44-
if progress
45-
then do
42+
, signalCurVal = const $ ifProgress
43+
<?> do
4644
x <- sample gen
4745
writeIORef vRef x
4846
memorize signalHistory x
4947
return x
50-
else
48+
<:>
5149
readIORef vRef
5250
, signalPrint = Nothing
53-
,..
51+
, ..
5452
}
5553

5654
-- | Extended version of 'generate', which allows to generate a finite
@@ -65,28 +63,24 @@ generateN def gen = do
6563
TBDomain{..} <- tbDomain @dom
6664

6765
vRef <- liftIO $ newIORef [def]
68-
checkForProgress <- progressCheck simStepRef False
66+
ifProgress <- progressCheck simStepRef False
6967
signalHistory <- newHistory
7068

7169
mind SomeSignal IOInput
7270
{ signalId = NoID
73-
, signalCurVal = const $ do
74-
progress <- checkForProgress
75-
76-
if progress
77-
then
78-
readIORef vRef >>= \case
79-
h : x : xr -> do
80-
memorize signalHistory h
81-
writeIORef vRef (x : xr)
82-
return x
83-
[h] -> do
84-
memorize signalHistory h
85-
x : xr <- sample gen
86-
writeIORef vRef (x : xr)
87-
return x
88-
_ -> error "unreachable"
89-
else readIORef vRef >>= \case
71+
, signalCurVal = const $ ifProgress
72+
<?> readIORef vRef >>= \case
73+
h : x : xr -> do
74+
memorize signalHistory h
75+
writeIORef vRef (x : xr)
76+
return x
77+
[h] -> do
78+
memorize signalHistory h
79+
x : xr <- sample gen
80+
writeIORef vRef (x : xr)
81+
return x
82+
_ -> error "unreachable"
83+
<:> readIORef vRef >>= \case
9084
x : _ -> return x
9185
[] -> do
9286
x : xr <- sample gen
@@ -107,22 +101,19 @@ matchIOGen checkedOutput gen = do
107101
TBDomain{..} <- tbDomain @dom
108102

109103
vRef <- liftIO $ newIORef undefined
110-
checkForProgress <- progressCheck simStepRef False
104+
ifProgress <- progressCheck simStepRef False
111105
signalHistory <- newHistory
112106

113107
mind SomeSignal $ IOInput
114108
{ signalId = NoID
115-
, signalCurVal = const $ do
116-
progress <- checkForProgress
117-
118-
if progress
119-
then do
109+
, signalCurVal = const $ ifProgress
110+
<?> do
120111
(input, expectedOutput) <- sample gen
121112
curStep <- readIORef simStepRef
122113
signalExpect checkedOutput $ Expectation (curStep, verifier expectedOutput)
123114
writeIORef vRef input
124115
return input
125-
else
116+
<:>
126117
readIORef vRef
127118
, signalPrint = Nothing
128119
, ..
@@ -157,42 +148,37 @@ matchIOGenN checkedOutput gen = mdo
157148

158149
xs <- liftIO $ sample gen
159150
modify $ \st@ST{..} -> st { simSteps = max simSteps $ length xs }
160-
liftIO $ Prelude.print xs
161151

162152
vRef <- liftIO $ newIORef xs
163-
checkForProgress <- progressCheck simStepRef False
153+
ifProgress <- progressCheck simStepRef False
164154
signalHistory <- newHistory
165155

166156
s <- mind SomeSignal $ IOInput
167157
{ signalId = NoID
168-
, signalCurVal = const $ do
169-
progress <- checkForProgress
170-
171-
readIORef vRef >>=
172-
if progress
173-
then \case
174-
(h, _) : (i, o) : xr -> do
175-
memorize signalHistory h
176-
writeIORef vRef ((i, o) : xr)
177-
curStep <- readIORef simStepRef
178-
signalExpect checkedOutput $ Expectation (curStep, verifier s i o)
179-
return i
180-
[(h, _)] -> do
181-
memorize signalHistory h
182-
(i, o) : xr <- sample gen
183-
184-
writeIORef vRef ((i, o) : xr)
185-
curStep <- readIORef simStepRef
186-
signalExpect checkedOutput $ Expectation (curStep, verifier s i o)
187-
return i
188-
_ -> error "unreachable"
189-
else \case
190-
(i, _) : _ -> return i
191-
[] -> do
192-
(i, o) : xr <- sample gen
193-
writeIORef vRef ((i, o) : xr)
194-
Prelude.print $ (i, o) : xr
195-
return i
158+
, signalCurVal = const $ ifProgress
159+
<?> readIORef vRef >>= \case
160+
(h, _) : (i, o) : xr -> do
161+
memorize signalHistory h
162+
writeIORef vRef ((i, o) : xr)
163+
curStep <- readIORef simStepRef
164+
signalExpect checkedOutput $ Expectation (curStep, verifier s i o)
165+
return i
166+
[(h, _)] -> do
167+
memorize signalHistory h
168+
(i, o) : xr <- sample gen
169+
170+
writeIORef vRef ((i, o) : xr)
171+
curStep <- readIORef simStepRef
172+
signalExpect checkedOutput $ Expectation (curStep, verifier s i o)
173+
return i
174+
_ -> error "unreachable"
175+
<:> readIORef vRef >>= \case
176+
(i, _) : _ -> return i
177+
[] -> do
178+
(i, o) : xr <- sample gen
179+
writeIORef vRef ((i, o) : xr)
180+
Prelude.print $ (i, o) : xr
181+
return i
196182
, signalPrint = Nothing
197183
, ..
198184
}

0 commit comments

Comments
 (0)