Commits

Aleksey Khudyakov  committed e07d164

Move tests to separate package

  • Participants
  • Parent commits caa6f02

Comments (0)

Files changed (8)

File histogram-fill-tests/LICENSE

+Copyright (c)2009-2012, Aleksey Khudyakov
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of asd nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

File histogram-fill-tests/Setup.hs

+import Distribution.Simple
+main = defaultMain

File histogram-fill-tests/Test.hs

+import Test.Tasty            (testGroup,defaultMain)
+import qualified Test.Histogram
+
+main :: IO ()
+main =
+  defaultMain $ testGroup "tests"
+    [ Test.Histogram.tests
+    ]

File histogram-fill-tests/Test/Histogram.hs

+{-# LANGUAGE FlexibleContexts  #-}
+module Test.Histogram (
+  tests
+  ) where
+
+import Data.Typeable
+
+import Test.QuickCheck
+import Test.Tasty            (TestTree,testGroup,defaultMain)
+import Test.Tasty.QuickCheck (testProperty)
+
+import Data.Histogram
+import Data.Histogram.Bin.MaybeBin
+import Data.Histogram.QuickCheck
+
+
+----------------------------------------------------------------
+--
+----------------------------------------------------------------
+
+tests :: [TestTree]
+tests = testGroup "Histogram"
+  [ testGroup "Bins"
+    [ testsBin (T :: T BinI)
+    , testsBin (T :: T BinInt) 
+    , testsBin (T :: T (BinF Float)) 
+    , testsBin (T :: T (BinF Float))
+    , testsBin (T :: T BinD)
+    , testsBin (T :: T (BinEnum Char))
+    , testsBin (T :: T LogBinD)
+    , testsBin (T :: T (MaybeBin BinI))
+    , testsBin (T :: T (Bin2D BinI BinI))
+    ]
+  , testGroup "fromIndex . toIndex == is" 
+    [ testProperty "BinI"    $ prop_FromTo (T :: T BinI)
+    , testProperty "BinEnum" $ prop_FromTo (T :: T (BinEnum Char))
+    , testProperty "Bin2D"   $ prop_FromTo (T :: T (Bin2D BinI BinI))
+    ]
+  , testGroup "Sliceable bins"
+    [ testSliceBin (T :: T BinI)
+    , testSliceBin (T :: T BinInt) 
+    , testSliceBin (T :: T (BinF Float)) 
+    , testSliceBin (T :: T (BinF Float))
+    , testSliceBin (T :: T BinD)
+    , testSliceBin (T :: T (BinEnum Char))
+    , testSliceBin (T :: T LogBinD)
+    ]      
+  , testGroup "Histogram"
+    [ testProperty "read . show"  (isIdentity (readHistogram . show) :: Histogram BinI Int -> Bool)
+    ]
+  ]
+
+testsBin :: ( Read a, Show a, Show (BinValue a), Eq a, Typeable a
+            , Bin a
+            , Arbitrary a, Arbitrary (BinValue a)
+            ) => T a -> TestTree
+testsBin t
+  = testGroup ("Bin test for " ++ show (typeOfT t))
+  [ testProperty "read . show = id"         $ prop_ReadShow t
+  , testProperty "toIndex . fromIndex = id" $ prop_ToFrom   t
+  , testProperty "inRange"                  $ prop_InRange  t
+  ]
+
+testSliceBin :: ( Show b, Typeable b, SliceableBin b, Arbitrary b
+                ) => T b -> TestTree
+testSliceBin t 
+  = testGroup ("Slice tests for" ++ show (typeOfT t))
+  [ testProperty "N of bins"  $ prop_sliceBin t
+  ]
+
+
+----------------------------------------------------------------
+-- Bin tests
+----------------------------------------------------------------
+
+-- > read . show == id
+prop_ReadShow :: (Read a, Show a, Eq a) => T a -> a -> Bool
+prop_ReadShow _ = isIdentity (read . show)
+
+-- > toIndex . fromIndex == id
+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), 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
+prop_InRange _ b x 
+  = inRange b x == indexInRange (toIndex b x)
+  where
+    indexInRange i = i >= 0  &&  i < nBins b
+
+-- Sliced bin have correct number of bins
+prop_sliceBin :: (SliceableBin b) => T b -> b -> Gen Bool
+prop_sliceBin _ bin = do
+  let n = nBins bin
+  i <- choose (0, n-1)
+  j <- choose (i, n-1)
+  return $ nBins (sliceBin i j bin) == (j - i + 1)
+
+
+
+----------------------------------------------------------------
+-- Helpers
+----------------------------------------------------------------
+
+isIdentity :: Eq a => (a -> a) -> a -> Bool
+isIdentity f x = x == f x
+
+data T a = T
+
+paramOfT :: T a -> a
+paramOfT _ = undefined
+
+typeOfT :: Typeable a => T a -> TypeRep
+typeOfT = typeOf . paramOfT

File histogram-fill-tests/histogram-fill-tests.cabal

+Name:           histogram-fill-tests
+Version:        0.6.2.1
+Synopsis:       Test suite for histograms
+Description:
+  Tests are moved to separate package because QuickCheck instances
+  are placed into separate packages so histogram-fill's test suite have
+  to depend on histogram-fill-quickcheck which depends on histogram-fill.
+  Cabal could not resolve such cycle. (Issue 960)
+
+Cabal-Version:  >= 1.6
+License:        BSD3
+License-File:   LICENSE
+Author:         Alexey Khudyakov
+Maintainer:     Alexey Khudyakov <alexey.skladnoy@gmail.com>
+Homepage:       https://github.com/Shimuuar/histogram-fill/
+Category:       Data
+Build-Type:     Simple
+
+
+source-repository head
+  type:     hg
+  location: http://bitbucket.org/Shimuuar/histogram-fill
+source-repository head
+  type:     git
+  location: http://github.com/Shimuuar/histogram-fill
+
+Library
+
+test-suite tests
+  Type:           exitcode-stdio-1.0
+  Ghc-options:    -O2 -Wall
+  Main-is:        Test.hs
+  Other-modules:
+    Test.Histogram
+  Build-depends:
+    base >=3 && < 5,
+    histogram-fill,
+    histogram-fill-quickcheck,
+    vector,
+    QuickCheck >= 2,
+    tasty,
+    tasty-quickcheck

File histogram-fill/histogram-fill.cabal

     Data.Histogram.Bin.Read
     Data.Histogram.ST
 
-test-suite tests
-  type:           exitcode-stdio-1.0
-  hs-source-dirs: test
-  main-is:        QC.hs
-  other-modules:  QC.Instances
-  ghc-options:    -O2 -Wall
-  build-depends:
-    base >=3 && < 5,
-    histogram-fill,
-    vector,
-    QuickCheck >= 2,
-    tasty,
-    tasty-quickcheck
-
 Benchmark benchmarks
   Type:           exitcode-stdio-1.0
   Main-is:        benchmark.hs

File histogram-fill/test/QC.hs

-{-# LANGUAGE FlexibleContexts  #-}
-import Data.Typeable
-
-import Test.QuickCheck
-import Test.Tasty            (TestTree,testGroup,defaultMain)
-import Test.Tasty.QuickCheck (testProperty)
-
-import Data.Histogram
-import Data.Histogram.Bin.MaybeBin
-import QC.Instances
-
-
-
-----------------------------------------------------------------
---
-----------------------------------------------------------------
-tests :: TestTree
-tests = testGroup "tests"
-  [ testGroup "Bins"
-    [ testsBin (T :: T BinI)
-    , testsBin (T :: T BinInt) 
-    , testsBin (T :: T (BinF Float)) 
-    , testsBin (T :: T (BinF Float))
-    , testsBin (T :: T BinD)
-    , testsBin (T :: T (BinEnum Char))
-    , testsBin (T :: T LogBinD)
-    , testsBin (T :: T (MaybeBin BinI))
-    , testsBin (T :: T (Bin2D BinI BinI))
-    ]
-  , testGroup "fromIndex . toIndex == is" 
-    [ testProperty "BinI"    $ prop_FromTo (T :: T BinI)
-    , testProperty "BinEnum" $ prop_FromTo (T :: T (BinEnum Char))
-    , testProperty "Bin2D"   $ prop_FromTo (T :: T (Bin2D BinI BinI))
-    ]
-  , testGroup "Sliceable bins"
-    [ testSliceBin (T :: T BinI)
-    , testSliceBin (T :: T BinInt) 
-    , testSliceBin (T :: T (BinF Float)) 
-    , testSliceBin (T :: T (BinF Float))
-    , testSliceBin (T :: T BinD)
-    , testSliceBin (T :: T (BinEnum Char))
-    , testSliceBin (T :: T LogBinD)
-    ]      
-  , testGroup "Histogram"
-    [ testProperty "read . show"  (isIdentity (readHistogram . show) :: Histogram BinI Int -> Bool)
-    ]
-  ]
-
-testsBin :: ( Read a, Show a, Show (BinValue a), Eq a, Typeable a
-            , Bin a
-            , Arbitrary a, Arbitrary (BinValue a)
-            ) => T a -> TestTree
-testsBin t
-  = testGroup ("Bin test for " ++ show (typeOfT t))
-  [ testProperty "read . show = id"         $ prop_ReadShow t
-  , testProperty "toIndex . fromIndex = id" $ prop_ToFrom   t
-  , testProperty "inRange"                  $ prop_InRange  t
-  ]
-
-testSliceBin :: ( Show b, Typeable b, SliceableBin b, Arbitrary b
-                ) => T b -> TestTree
-testSliceBin t 
-  = testGroup ("Slice tests for" ++ show (typeOfT t))
-  [ testProperty "N of bins"  $ prop_sliceBin t
-  ]
-
-
-----------------------------------------------------------------
--- Bin tests
-----------------------------------------------------------------
-
--- > read . show == id
-prop_ReadShow :: (Read a, Show a, Eq a) => T a -> a -> Bool
-prop_ReadShow _ = isIdentity (read . show)
-
--- > toIndex . fromIndex == id
-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), 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
-prop_InRange _ b x 
-  = inRange b x == indexInRange (toIndex b x)
-  where
-    indexInRange i = i >= 0  &&  i < nBins b
-
--- Sliced bin have correct number of bins
-prop_sliceBin :: (SliceableBin b) => T b -> b -> Gen Bool
-prop_sliceBin _ bin = do
-  let n = nBins bin
-  i <- choose (0, n-1)
-  j <- choose (i, n-1)
-  return $ nBins (sliceBin i j bin) == (j - i + 1)
-
-
-
-----------------------------------------------------------------
--- Helpers
-----------------------------------------------------------------
-
-isIdentity :: Eq a => (a -> a) -> a -> Bool
-isIdentity f x = x == f x
-
-data T a = T
-
-paramOfT :: T a -> a
-paramOfT _ = undefined
-
-typeOfT :: Typeable a => T a -> TypeRep
-typeOfT = typeOf . paramOfT
-
-----------------------------------------------------------------
--- Main
-----------------------------------------------------------------
-
-main :: IO ()
-main =
-  defaultMain tests

File histogram-fill/test/QC/Instances.hs

--- Yes I DO want orphans here
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-{-# LANGUAGE FlexibleInstances #-}
-module QC.Instances where
-
-import Control.Applicative
-import Test.QuickCheck
-import qualified Data.Vector.Unboxed as U
-
-import Data.Histogram
-import Data.Histogram.Bin.MaybeBin
-
-
-
-----------------------------------------------------------------
--- Bin instances
-----------------------------------------------------------------
-
-instance Arbitrary BinI where
-  arbitrary = do
-    let maxI = 100
-    lo <- choose (-maxI , maxI)
-    hi <- choose (lo    , maxI)
-    return $ binI lo hi
-
-instance Arbitrary BinInt where
-  arbitrary = do
-    let maxI = 100
-    base <- choose (-maxI,maxI)
-    step <- choose (1,10)
-    n    <- choose (1,1000)
-    return $ BinInt base step n
-
-instance (Arbitrary a, Ord a, Enum a) => Arbitrary (BinEnum a) where
-  arbitrary = do
-    l <- arbitrary
-    h <- suchThat arbitrary (>= l)
-    return $ binEnum l h
-
-instance Arbitrary (BinF Float) where
-  arbitrary = do
-    lo <- choose (-1.0e+3-1 , 1.0e+3)
-    n  <- choose (1, 1000)
-    hi <- choose (lo , 1.0e+3+1)
-    return $ binF lo n hi
-
-instance Arbitrary (BinF Double) where
-  arbitrary = do
-    lo <- choose (-1.0e+6-1 , 1.0e+6)
-    n  <- choose (1, 1000*1000)
-    hi <- choose (lo , 1.0e+6+1)
-    return $ binF lo n hi
-
-instance Arbitrary BinD where
-  arbitrary = do
-    lo <- choose (-1.0e+6-1 , 1.0e+6)
-    n  <- choose (1, 1000*1000)
-    hi <- choose (lo , 1.0e+6+1)
-    return $ binD lo n hi
-
-instance Arbitrary LogBinD where
-  arbitrary = do
-    lo <- choose (1.0e-6 , 1.0e+6)
-    n  <- choose (1, 1000*1000)
-    hi <- choose (lo , 1.0e+6+1)
-    return $ logBinD lo n hi
-
-instance Arbitrary bin => Arbitrary (MaybeBin bin) where
-  arbitrary = MaybeBin <$> arbitrary
-
-instance (Arbitrary bx, Arbitrary by) => Arbitrary (Bin2D bx by) where
-    arbitrary = Bin2D <$> arbitrary <*> arbitrary
-
-----------------------------------------------------------------
--- Histogram instance
-----------------------------------------------------------------
-
-instance (Bin bin, U.Unbox a, Arbitrary bin, Arbitrary a) => Arbitrary (Histogram bin a) where
-    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