From 264149ef3fd4943e3e88ad29d27cecc603ee2c58 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 6 Mar 2008 01:49:33 +0000 Subject: [PATCH] Added some more tests for dynamically sized arrays --- backends/BackendPassesTest.hs | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/backends/BackendPassesTest.hs b/backends/BackendPassesTest.hs index 43d73d4..428c5f4a 100644 --- a/backends/BackendPassesTest.hs +++ b/backends/BackendPassesTest.hs @@ -172,6 +172,23 @@ instance Arbitrary StaticTypeList where ] return $ StaticTypeList tl +newtype DynTypeList = DynTypeList [A.Type] deriving (Show) + +instance Arbitrary DynTypeList 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) + ds <- replicateM len $ oneof + [choose (1,1000) >>* A.Dimension + ,return A.UnknownDimension] + t <- oneof [return A.Int, return A.Byte] + return $ A.Array ds t) + ] + return $ DynTypeList tl + + qcTestDeclareSizes :: [LabelledQuickCheckTest] qcTestDeclareSizes = [ @@ -270,8 +287,10 @@ checkName n spec am cs qcTestSizeParameters :: [LabelledQuickCheckTest] qcTestSizeParameters = [ - ("Test Adding _sizes parameters to PROC formals", scaleQC (20, 100, 500, 1000) (runQCTest . testFormal . \(StaticTypeList ts) -> ts)) - ,("Test Adding _sizes parameters to PROC actuals", scaleQC (20, 100, 500, 1000) (runQCTest . testActual . \(StaticTypeList ts) -> ts)) + ("Test Adding _sizes parameters to PROC formals (static)", scaleQC (20, 100, 500, 1000) (runQCTest . testFormal . \(StaticTypeList ts) -> ts)) + ,("Test Adding _sizes parameters to PROC actuals (static)", scaleQC (20, 100, 500, 1000) (runQCTest . testActual . \(StaticTypeList ts) -> ts)) + ,("Test Adding _sizes parameters to PROC formals (dynamic)", scaleQC (20, 100, 500, 1000) (runQCTest . testFormal . \(DynTypeList ts) -> ts)) + ,("Test Adding _sizes parameters to PROC actuals (dynamic)", scaleQC (20, 100, 500, 1000) (runQCTest . testActual . \(DynTypeList ts) -> ts)) ] where -- TODO need to test both with dynamically sized arrays