From c21fee44d41b757c7931ebe7c16fda9c19e65c53 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 6 Mar 2008 17:50:19 +0000 Subject: [PATCH] Added test for adding sizes to an Is array abbreviation --- backends/BackendPassesTest.hs | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 428c5f4a..9afb8b0 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -188,6 +188,24 @@ instance Arbitrary DynTypeList where ] return $ DynTypeList tl +-- types of thing being abbreviated, types of abbreviation, subscripts +newtype AbbrevTypesIs = AbbrevTypesIs ([A.Dimension], [A.Dimension], [A.Subscript]) deriving (Show) + +instance Arbitrary AbbrevTypesIs where + arbitrary = do lenSrc <- choose (1,10) + lenDest <- choose (1, lenSrc) + srcDims <- replicateM lenSrc $ oneof [return A.UnknownDimension, choose (1,1000) >>* A.Dimension] + destDims <- flip mapM (take lenDest srcDims) $ \d -> + case d of + A.UnknownDimension -> return A.UnknownDimension + _ -> oneof [return d, return A.UnknownDimension] + subs <- replicateM (length srcDims - length destDims) $ oneof + [return $ A.Subscript emptyMeta (A.True emptyMeta) + ,return $ A.SubscriptFromFor emptyMeta (A.True emptyMeta) (A.True emptyMeta) + ,return $ A.SubscriptFrom emptyMeta (A.True emptyMeta) + ,return $ A.SubscriptFor emptyMeta (A.True emptyMeta) + ] + return $ AbbrevTypesIs (srcDims, destDims, subs) qcTestDeclareSizes :: [LabelledQuickCheckTest] qcTestDeclareSizes = @@ -196,7 +214,10 @@ qcTestDeclareSizes = ,("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)) - --TODO test that arrays that are abbreviations (Is and IsExpr) also get _sizes arrays, and that they are initialised correctly + ,("Test Adding _sizes For Is", scaleQC (20, 100, 500, 1000) + (\(AbbrevTypesIs dds@(_,dds',_)) -> A.UnknownDimension `elem` dds' ==> (runQCTest $ testFoo 3 $ isIsFoo dds))) + + --TODO test that arrays that are abbreviations (IsExpr left to do) also get _sizes arrays, and that they are initialised correctly --TODO test reshapes/retypes abbreviations ] where @@ -215,6 +236,18 @@ qcTestDeclareSizes = 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 ()) + isIsFoo :: ([A.Dimension], [A.Dimension], [A.Subscript]) -> (A.SpecType, A.SpecType, State CompState ()) + isIsFoo (srcDims, destDims, subs) + = (A.Is emptyMeta A.Abbrev (A.Array destDims A.Byte) + (foldr (A.SubscriptedVariable emptyMeta) (variable "src") subs) + ,specSizes, defSrc) + where + specSizes = A.Is emptyMeta A.ValAbbrev (A.Array [A.Dimension $ length destDims] A.Int) $ + A.SubscriptedVariable emptyMeta (A.SubscriptFrom emptyMeta (intLiteral $ toInteger $ length srcDims - length destDims)) (variable "src_sizes") + defSrc = do defineTestName "src" (A.Declaration emptyMeta (A.Array srcDims A.Byte) Nothing) A.Original + defineTestName "src_sizes" (A.IsExpr emptyMeta A.ValAbbrev (A.Array srcDims A.Byte) dummyExpr) A.ValAbbrev + dummyExpr = A.True emptyMeta + 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)