From 6a784bffd9b188cb38512c1c9facb4e0a86a648e Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Wed, 5 Mar 2008 16:35:37 +0000 Subject: [PATCH] Switch the tests for declareSizesArray to be QuickCheck tests rather than HUnit tests --- TestMain.hs | 4 +- backends/BackendPassesTest.hs | 93 +++++++++++++++++++---------------- 2 files changed, 53 insertions(+), 44 deletions(-) diff --git a/TestMain.hs b/TestMain.hs index 5fe35d8..9a819bf 100644 --- a/TestMain.hs +++ b/TestMain.hs @@ -47,7 +47,7 @@ import System.IO import Test.HUnit import qualified ArrayUsageCheckTest (ioqcTests) -import qualified BackendPassesTest (tests) +import qualified BackendPassesTest (qcTests) import qualified CommonTest (tests) import qualified FlowGraphTest (qcTests) import qualified GenerateCTest (tests) @@ -145,7 +145,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options tests :: [IO (Test, [LabelledQuickCheckTest])] tests = [ ArrayUsageCheckTest.ioqcTests - ,noqc BackendPassesTest.tests + ,return BackendPassesTest.qcTests ,noqc CommonTest.tests ,return FlowGraphTest.qcTests ,noqc GenerateCTest.tests diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index b3bab67..cefe3e7 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -19,12 +19,13 @@ with this program. If not, see . -- #ignore-exports -- | Currently contains tests just for the transformWaitFor pass that is run for the C backend. -module BackendPassesTest (tests) where +module BackendPassesTest (qcTests) where import Control.Monad.State import Data.Generics import qualified Data.Map as Map import Test.HUnit hiding (State) +import Test.QuickCheck import qualified AST as A import BackendPasses @@ -32,6 +33,7 @@ import CompState import Metadata import Pattern import TagAST +import TestFramework import TestUtils import TreeUtils import Utils @@ -145,39 +147,44 @@ testTransformWaitFor5 = TestCase $ testPass "testTransformWaitFor5" exp (transfo var1 = tag2 A.Variable DontCare varName1 evar1 = tag2 A.ExprVariable DontCare var1 -testDeclareSizes :: Test -testDeclareSizes = TestList - [ - testFoo 0 $ declFoo [4] - ,testFoo 1 $ declFoo [4,5] - ,testFoo 2 $ declFoo [4,5,6,7,8] - - ,testFoo 10 $ isChanArrFoo 1 - ,testFoo 11 $ isChanArrFoo 2 - ,testFoo 12 $ isChanArrFoo 3 - - ,testRecordFoo 20 [] - ,testRecordFoo 21 [A.Int] - ,testRecordFoo 22 [A.Array [A.Dimension 3] A.Int] - ,testRecordFoo 23 [A.Array (map A.Dimension [3,4,5,6]) A.Int] +newtype PosInts = PosInts [Int] deriving (Show) + +instance Arbitrary PosInts where + arbitrary = do len <- choose (1, 10) + replicateM len (choose (1,1000)) >>* PosInts + +newtype PosInt = PosInt Int deriving (Show) + +instance Arbitrary PosInt where + arbitrary = choose (1,20) >>* PosInt + +newtype StaticTypeList = StaticTypeList [A.Type] deriving (Show) + +instance Arbitrary StaticTypeList where + arbitrary = do len <- choose (1,10) + tl <- replicateM len $ frequency + [ (10, return A.Int) + , (10, return A.Byte) + , (20, do len <- choose (1,5) + ns <- replicateM len $ choose (1,1000) + t <- oneof [return A.Int, return A.Byte] + return $ A.Array (map A.Dimension ns) t) + ] + return $ StaticTypeList tl + +qcTestDeclareSizes :: [LabelledQuickCheckTest] +qcTestDeclareSizes = + [ + ("Test Adding _sizes For Declarations", scaleQC (20, 100, 500, 1000) (runQCTest . testFoo 0 . declFoo . \(PosInts xs) -> xs)) + ,("Test Adding _sizes For IsChannelArray", scaleQC (20, 100, 500, 1000) (runQCTest . testFoo 1 . isChanArrFoo . \(PosInt x) -> x)) + ,("Test Adding _sizes For RecordType", scaleQC (20, 100, 500, 1000) (runQCTest . testRecordFoo 2 . \(StaticTypeList ts) -> ts)) - ,testRecordFoo 24 [A.Int, A.Array [A.Dimension 3] A.Int] - ,testRecordFoo 25 [A.Byte, A.Int, A.Array [A.Dimension 3] A.Int, A.Array (map A.Dimension [3,4,5,6]) A.Int, A.Array (map A.Dimension [1,2]) A.Int] - -{- - ,testFooDecl 10 [Nothing] - ,testFooDecl 11 [Just 4, Nothing] - ,testFooDecl 12 [Nothing, Nothing] - ,testFooDecl 13 [Nothing, Nothing, Nothing, Nothing] - ,testFooDecl 14 [Nothing, Just 5, Just 6] - ,testFooDecl 15 [Just 4, Nothing, Just 5, Nothing, Nothing] --} --TODO test that arrays that are abbreviations (Is and IsExpr) also get _sizes arrays, and that they are initialised correctly --TODO test reshapes/retypes abbreviations ] where -- spectype of foo, spectype of foo_sizes - testFoo :: Int -> (A.SpecType, A.SpecType, State CompState ()) -> Test + testFoo :: TestMonad m r => Int -> (A.SpecType, A.SpecType, State CompState ()) -> m () testFoo n (fooSpec, fooSizesSpec, st) = test n (strFoo $ strFooSizes term) (strFoo term) st (checkFooSizes fooSizesSpec) @@ -189,7 +196,7 @@ testDeclareSizes = TestList isChanArrFoo n = (A.IsChannelArray emptyMeta (A.Array [A.Dimension n] $ A.Chan A.DirUnknown (A.ChanAttributes False False) A.Byte) (replicate n $ variable "c") ,valSize [n], return ()) - testRecordFoo :: Int -> [A.Type] -> Test + testRecordFoo :: forall m r. TestMonad m r => Int -> [A.Type] -> m () -- Give fields arbitrary names (for testing), then check that all ones that are array types -- do get _sizes array (concat of array name, field name and _sizes) testRecordFoo n ts = test n @@ -208,7 +215,7 @@ testDeclareSizes = TestList valSize $ map (\(A.Dimension n) -> n) ds) declSizeItems _ = id - checkSizeItems :: (String, A.Type) -> CompState -> Assertion + checkSizeItems :: (String, A.Type) -> CompState -> m () checkSizeItems (n, A.Array ds _) = checkSizes ("foo" ++ n) (valSize $ map (\(A.Dimension n) -> n) ds) checkSizeItems _ = const (return ()) @@ -224,35 +231,37 @@ testDeclareSizes = TestList makeSizesLiteral xs = A.Literal emptyMeta (A.Array [A.Dimension $ length xs] A.Int) $ A.ArrayLiteral emptyMeta $ map (A.ArrayElemExpr . A.Literal emptyMeta A.Int . A.IntLiteral emptyMeta . show) xs + checkFooSizes :: TestMonad m r => A.SpecType -> CompState -> m () checkFooSizes = checkSizes "foo_sizes" - checkSizes :: String -> A.SpecType -> CompState -> Assertion + checkSizes :: TestMonad m r => String -> A.SpecType -> CompState -> m () checkSizes n spec cs = do nd <- case Map.lookup n (csNames cs) of Just nd -> return nd - Nothing -> assertFailure ("Could not find " ++ n) >> return undefined - assertEqual "ndName" n (A.ndName nd) - assertEqual "ndOrigName" n (A.ndOrigName nd) - assertEqual "ndType" spec (A.ndType nd) - assertEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd) + Nothing -> testFailure ("Could not find " ++ n) >> return undefined + testEqual "ndName" n (A.ndName nd) + testEqual "ndOrigName" n (A.ndOrigName nd) + testEqual "ndType" spec (A.ndType nd) + testEqual "ndAbbrevMode" A.ValAbbrev (A.ndAbbrevMode nd) term = A.Only emptyMeta () - test :: Int -> A.Structured () -> A.Structured () -> State CompState () -> (CompState -> Assertion) -> Test - test n exp inp st chk = TestLabel label $ TestCase $ testPassWithStateCheck label exp (declareSizesArray inp) st chk + test :: TestMonad m r => Int -> A.Structured () -> A.Structured () -> State CompState () -> (CompState -> m ()) -> m () + test n exp inp st chk = testPassWithStateCheck label exp (declareSizesArray inp) st chk where label = "testDeclareSizes " ++ show n ---Returns the list of tests: -tests :: Test -tests = TestLabel "BackendPassesTest" $ TestList +qcTests :: (Test, [LabelledQuickCheckTest]) +qcTests = (TestLabel "BackendPassesTest" $ TestList [ - testDeclareSizes - ,testTransformWaitFor0 +-- ,testSizeParameters + testTransformWaitFor0 ,testTransformWaitFor1 ,testTransformWaitFor2 ,testTransformWaitFor3 ,testTransformWaitFor4 ,testTransformWaitFor5 ] + ,qcTestDeclareSizes)