forsyde-deep-0.2.0: tests/examples/VHDLBackend.hs
{-# LANGUAGE TemplateHaskell #-}
-- VHDL-Backend property testing module
-- ALl the tests are based on asserting that the internal simulation of the system
-- equals the simulation of the generated vhdl code with modelsim
module VHDLBackend (vhdlBackendTest) where
-- import the example-modules
import ALU
--import Counter
import ParAddFour
import Multiplexer
--import Multiplexer_FSVector
import SeqAddFour
import ButtonEncoder
import ZipTwist
import CarrySelectAdder
import Null
import LFSR
import MapVector
import MapVectorOperatorSection
import MapVectorTransformation
import MapLambdaVector
import FoldlVector
import ZipWithVector
import FoldlVectorOperator
import ZipWithVectorOperator
import Control.Monad (liftM, replicateM)
import Data.List (transpose)
import Data.Param.FSVec (vectorTH, reallyUnsafeVector)
import System.Random
import Test.HUnit
import ForSyDe.Deep
import Data.Int
import Test.QuickCheck (generate, vectorOf, choose)
vhdlBackendTest :: Test
vhdlBackendTest = test [aluTest,
--counterTest,
parAddFourTest,
muxTest,
--muxFSVecTest,
seqAddFourTest,
buttonEncoderTest,
zipTwistTest,
nullTest,
lfsrTest,
mapVTest,
mapVectorTransformationTest,
mapLambdaVectorTest,
mapVectorOperatorSectionTest,
foldlVOpTest,
zipWithVOpTest,
foldlVTest,
zipWithVTest
]
-- systematic test for the ALU
aluTest :: Test
aluTest = "aluTest" ~: outSim <~=?> outVHDL
where and = $(vectorTH [H,H])
or = $(vectorTH [H,L])
add = $(vectorTH [L,H])
shiftl = $(vectorTH [L,L])
fourBitCombs = map reallyUnsafeVector (combN 4 [L,H])
[arg1,arg2] = parCombN 2 fourBitCombs
l = length arg1
select = replicate l and ++
replicate l or ++
replicate l add ++
replicate l shiftl
op1 = arg1 ++ arg1 ++ arg1 ++ arg1
op2 = arg2 ++ arg2 ++ arg2 ++ arg2
outSim = simALU select op1 op2
outVHDL = vhdlTest Nothing aluSys select op1 op2
counterTest :: Test
counterTest = TestCase $ assertFailure "Not running counterTest due to broken newSysFunTHName"
--counterTest = "counterTest" ~: "first 400 outputs" ~:
-- out400Sim <~=?> out400VHDLSim
-- where out400Sim = take 400 simCounter
-- out400VHDLSim = vhdlTest (Just 400) counterSys
parAddFourTest :: Test
parAddFourTest = "parAddFourTest" ~: test doTest
where -- testt the overflows, and 400 different pseudorandom numbers
lastInt32 :: Num a => a
lastInt32 = 2147483647
firstInt32 :: Num a => a
-- FIXME: this should be -2147483648, but due to bug http://code.google.com/p/forsyde-comp/issues/detail?id=22 it was set to -2147483647
firstInt32 = -2147483647
gen400Int32 :: IO [Int32]
gen400Int32 = do
let randomInt32 :: IO Int32
randomInt32 = do
let getInt32Range :: IO Integer
getInt32Range = getStdRandom (randomR (firstInt32, lastInt32))
liftM fromIntegral getInt32Range
replicateM 400 randomInt32
doTest :: IO ()
doTest = do arg1 <- gen400Int32
arg2 <- gen400Int32
arg3 <- gen400Int32
arg4 <- gen400Int32
arg5 <- gen400Int32
let sim = simParAddFour (1:(-1):arg1)
-- (firstInt32:lastInt32:arg2)
-- (lastInt32:firstInt32:arg3)
arg2
arg3
(-1:1:arg4)
(0:1:arg5)
simVHDL = vhdlTest Nothing
parAddFourSys
(1:(-1):arg1)
-- (firstInt32:lastInt32:arg2)
-- (lastInt32:firstInt32:arg3)
arg2
arg3
(-1:1:arg4)
(0:1:arg5)
resVHDL <- simVHDL
sim @=? resVHDL
muxTest :: Test
muxTest = "muxTest" ~: Multiplexer.simMux sel input <~=?>
vhdlTest Nothing Multiplexer.muxSysDef sel input
where sel = [(L,L),(L,H),(H,L),(H,H)]
input = [(L,L,L,H),(L,L,H,L),(L,H,L,L),(H,L,L,L)]
muxFSVecTest :: Test
muxFSVecTest = TestCase $ assertFailure "Not running muxFSVecTest due to broken newSysFunTHName"
--muxFSVecTest = "muxTest" ~: Multiplexer_FSVector.simMux sel input <~=?>
-- vhdlTest Nothing Multiplexer_FSVector.muxSysDef sel input
-- where sel = [$(vectorTH [L,L]),$(vectorTH [L,H]),$(vectorTH [H,L]),$(vectorTH [H,H])]
-- input = [$(vectorTH [L,L,L,H]), $(vectorTH [L,L,H,L]), $(vectorTH [L,H,L,L]),
-- $(vectorTH [H,L,L,L])]
--
seqAddFourTest :: Test
seqAddFourTest = "seqAddFourTest" ~: simAddFour input <~=?>
vhdlTest Nothing addFourSys input
where input = [-100,-99..100]
buttonEncoderTest :: Test
buttonEncoderTest = "buttonEncoderTest" ~: simButtonEncoder input <~=?>
vhdlTest Nothing buttonEncoderSys input
where input = [(H,L,L,L), (L,H,L,L), (L,L,H,L), (L,L,L,H), (L,L,L,L)]
zipTwistTest :: Test
zipTwistTest = "zipTwistTest" ~:
simZipTwist input1 input2 input3 input4 input5 input6 <~=?>
vhdlTest Nothing zipTwistSys input1 input2 input3 input4 input5 input6
where input1 = [-100..0]
input2 = [-10..90]
input3 = [100..200]
input4 = [350..450]
input5 = [-400..(-300)]
input6 = [-50..50]
nullTest :: Test
-- we don't test quartus here, because it complains about no logic
--nullTest = "nullTest" ~: simNull <~=?> writeAndModelsimVHDL Nothing nullSysDef
nullTest = "nullTest" ~: simNull <~=?> vhdlTest Nothing nullSysDef
lfsrTest :: Test
lfsrTest = "lsfrTest" ~: outSim <~=?> outVHDL
where take400Tup4 (i1,i2,i3,i4) = (take 400 i1, take 400 i2, take 400 i3,
take 400 i4)
outSim = take400Tup4 simlfsr
outVHDL = vhdlTest (Just 400) lfsrSys
mapVTest :: Test
mapVTest = "mapVTest" ~: outSim <~=?> outVHDL
where
outSim = take 100 simVecCounter
outVHDL = vhdlTest (Just 100) vecCounterSys
foldlVTest :: Test
foldlVTest = "foldlVTest" ~: TestCase ioTest
where
int32Range = (-2147483647,2147483647):: (Int32, Int32)
ioTest = do
testData <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
let input = map reallyUnsafeVector testData
outSim = simFoldingAdder input
outVHDL <- vhdlTest (Just 100) foldingAdderSys input
outSim @=? outVHDL
zipWithVTest :: Test
zipWithVTest = "zipWithVTest" ~: TestCase ioTest
where
int32Range = (-2147483647,2147483647):: (Int32, Int32)
ioTest = do
testDataA <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
testDataB <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
let inputA = map reallyUnsafeVector testDataA
inputB = map reallyUnsafeVector testDataB
outSim = simZipWithVSys inputA inputB
outVHDL <- vhdlTest (Just 100) zipWithVSys inputA inputB
outSim @=? outVHDL
foldlVOpTest :: Test
foldlVOpTest = "foldlVOpTest" ~: TestCase ioTest
where
int32Range = (-2147483647,2147483647):: (Int32, Int32)
ioTest = do
testData <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
let input = map reallyUnsafeVector testData
outSim = simFoldingAdderOp input
outVHDL <- vhdlTest (Just 100) foldingAdderOpSys input
outSim @=? outVHDL
zipWithVOpTest :: Test
zipWithVOpTest = "zipWithVOpTest" ~: TestCase ioTest
where
int32Range = (-2147483647,2147483647):: (Int32, Int32)
ioTest = do
testDataA <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
testDataB <- generate.(vectorOf 100).(vectorOf 4).choose $ int32Range
let inputA = map reallyUnsafeVector testDataA
inputB = map reallyUnsafeVector testDataB
outSim = simZipWithVOpSys inputA inputB
outVHDL <- vhdlTest (Just 100) zipWithVOpSys inputA inputB
outSim @=? outVHDL
mapVectorOperatorSectionTest :: Test
mapVectorOperatorSectionTest = "mapVectorOperatorSectionTest" ~: outSim <~=?> outVHDL
where
outSim = take 100 simVecOpSecCounter
outVHDL = vhdlTest (Just 100) vecOpSecCounterSys
mapLambdaVectorTest :: Test
mapLambdaVectorTest = "mapLambdaVectorTest" ~: outSim <~=?> outVHDL
where
outSim = take 100 simLamVecCounter
outVHDL = vhdlTest (Just 100) vecLamCounterSys
mapVectorTransformationTest :: Test
mapVectorTransformationTest = "mapVectorTransformationTest" ~: outSim <~=?> outVHDL
where
outSim = take 100 simTransfVecCounter
outVHDL = vhdlTest (Just 100) transfVecCounterSys
-------------------
-- Helper functions
-------------------
-- run a vhdl testbench with custom backend options
vhdlTest :: SysFunToIOSimFun sysF simF => Maybe Int -> SysDef sysF -> simF
-- vhdlTest = writeAndModelsimVHDLOps testVHDLOps
vhdlTest = writeAndGhdlVHDL
-- testing VHDL options
testVHDLOps :: VHDLOps
testVHDLOps = defaultVHDLOps{execQuartus=Just checkSynthesisQuartus}
-- Compare an IO test with a pure expected result
(<~=?>) :: (Eq a, Show a) => a -> IO a -> Test
expected <~=?> actualM = TestCase $ do a <- actualM
expected @=? a
-- | permutation a list
-- Each element of the input list indicates the posibilities of each
-- positional elements in the resulting lists
permut :: [[a]] -> [[a]]
permut [] = []
permut [xs] = map (\x -> [x]) xs
permut (xs:xss) = let res = permut xss
in concatMap (\e -> map (:e) xs) res
-- | Combinations of 2 elements from a set of values
comb2 :: [a] -> [(a,a)]
comb2 xs = concatMap (\i -> map (\j -> (i,j) ) xs) xs
-- | Parallel combination of N elements
parCombN :: Int -> [a] -> [[a]]
parCombN n xs = transpose $ combN n xs
-- | Combinations os N elements from a set of values
combN :: Int -> [a] -> [[a]]
combN n _ | n <= 0 = []
combN 1 xs = map (\x -> [x]) xs
combN n xs = let res = combN (n-1) xs
in concatMap (\i -> map (\j -> j:i) xs) res