Commits

Aleksey Khudyakov committed c288be4

Fix test suite

  • Participants
  • Parent commits 43c36bf

Comments (0)

Files changed (2)

histogram-fill/test/QC.hs

 
 import Data.Histogram
 import Data.Histogram.Bin.MaybeBin
-import QC.Instances ()
+import QC.Instances
 
 
 
 prop_ReadShow _ = isIdentity (read . show)
 
 -- > toIndex . fromIndex == id
-prop_ToFrom :: Bin bin => T bin -> Int -> bin -> Property
-prop_ToFrom _ i bin =
-  i >= 0 && i < nBins bin  ==>  isIdentity (toIndex bin . fromIndex bin) i
+prop_ToFrom :: Bin bin => T bin -> bin -> Gen Bool
+prop_ToFrom _ bin = do
+  i <- choose (0,nBins bin - 1)
+  return $ isIdentity (toIndex bin . fromIndex bin) i
 
 -- > fromIndex . toIndex == id
 -- Hold only for integral bins
-prop_FromTo :: (Bin bin, Eq (BinValue bin)) => T bin -> BinValue bin -> bin -> Property
-prop_FromTo _ x bin =
-  inRange bin x  ==>  isIdentity (fromIndex bin . toIndex bin) x
+prop_FromTo :: (Bin bin, Eq (BinValue bin), ArbitraryBin bin)
+            => T bin -> bin -> Gen Bool
+prop_FromTo _ bin = do
+  x <- arbitraryBinVal bin
+  return $ isIdentity (fromIndex bin . toIndex bin) x
 
 -- > inRange b x == indexInRange b x
 prop_InRange :: (Bin bin) => T bin -> bin -> BinValue bin -> Bool

histogram-fill/test/QC/Instances.hs

 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-# LANGUAGE FlexibleInstances #-}
-module QC.Instances() where
+module QC.Instances where
 
 import Control.Applicative
 import Test.QuickCheck
     arbitrary = do
       bin <- suchThat arbitrary ((<333) . nBins)
       histogramUO bin <$> arbitrary <*> (U.fromList <$> vectorOf (nBins bin) arbitrary)
+
+
+----------------------------------------------------------------
+-- Arbitrary for bin values
+----------------------------------------------------------------
+
+-- | It's difficult to generate values that will fall into allowed
+--   range of the bin. Simple @inRange x ===> ...@ won't do because QC
+--   will generate large and larger values and eventually will give up.
+class ArbitraryBin bin where
+  -- | Generates arbitrary bin value that lies in range
+  arbitraryBinVal :: bin -> Gen (BinValue bin)
+
+instance ArbitraryBin BinI where
+  arbitraryBinVal bin = choose (lowerLimit bin, lowerLimit bin)
+
+instance (Enum e, Ord e) => ArbitraryBin (BinEnum e) where
+  arbitraryBinVal bin =
+    toEnum <$> choose (fromEnum $ lowerLimit bin, fromEnum $ lowerLimit bin)
+
+instance (ArbitraryBin bX, ArbitraryBin bY) => ArbitraryBin (Bin2D bX bY) where
+  arbitraryBinVal (Bin2D bX bY) =
+    (,) <$> arbitraryBinVal bX <*> arbitraryBinVal bY