{-# 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