diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -16,20 +16,17 @@ - CABALVER=1.18 GHCVER=7.6.3 # - CABALVER=1.18 GHCVER=7.8.1 # see note about Alex/Happy for GHC >= 7.8 # - CABALVER=1.18 GHCVER=7.8.2 - - CABALVER=1.18 GHCVER=7.8.3 - - CABALVER=1.22 GHCVER=7.10.1 +# - CABALVER=1.18 GHCVER=7.8.3 + - CABALVER=1.18 GHCVER=7.8.4 COVERAGE=1 + - CABALVER=1.22 GHCVER=7.10.2 # - CABALVER=head GHCVER=head # see section about GHC HEAD snapshots -matrix: - allow_failures: - - env: CABALVER=1.22 GHCVER=7.10.1 - # Note: the distinction between `before_install` and `install` is not important. before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:~/.cabal/bin:$PATH:$PATH - | if [ $GHCVER = "head" ] || [ ${GHCVER%.*} = "7.8" ] || [ ${GHCVER%.*} = "7.10" ]; then travis_retry sudo apt-get install happy-1.19.4 alex-3.1.3 @@ -42,16 +39,19 @@ - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - travis_retry cabal update + - "[ -n \"$COVERAGE\" ] && cabal install hpc-coveralls || true" + - cabal install hlint - cabal install --only-dependencies --enable-tests --enable-benchmarks # Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail. script: - if [ -f configure.ac ]; then autoreconf -i; fi - - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + - cabal configure --enable-tests --enable-benchmarks -v2 $([ "$COVERAGE" = "1" ] && echo "--enable-library-coverage") # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test - cabal check - cabal sdist # tests that a source-distribution can be generated + - hlint --cpp-file=dist/build/autogen/cabal_macros.h src # The following scriptlet checks that the resulting source distribution can be built & installed - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; @@ -61,4 +61,10 @@ else echo "expected '$SRC_TGZ' not found"; exit 1; - fi + fi ; + cd .. + +after_script: + - travis_retry sudo apt-get install tree + - tree dist/ # temporarily needed to investigate issue with hpc-coveralls + - "[ -n \"$COVERAGE\" ] && hpc-coveralls TestSign --exclude-dir=test || true" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ sign ==== -[![Build Status](https://secure.travis-ci.org/msakai/sign.png?branch=master)](http://travis-ci.org/msakai/sign) [![Hackage](https://budueba.com/hackage/sign)](https://hackage.haskell.org/package/sign) +[![Build Status](https://secure.travis-ci.org/msakai/sign.png?branch=master)](http://travis-ci.org/msakai/sign) [![Hackage](https://budueba.com/hackage/sign)](https://hackage.haskell.org/package/sign) [![Coverage Status](https://coveralls.io/repos/msakai/sign/badge.svg)](https://coveralls.io/r/msakai/sign) Arithmetic over signs (i.e. {-,0,+}) and sets of signs diff --git a/sign.cabal b/sign.cabal --- a/sign.cabal +++ b/sign.cabal @@ -1,5 +1,5 @@ Name: sign -Version: 0.4.1 +Version: 0.4.2 License: BSD3 License-File: LICENSE Author: Masahiro Sakai (masahiro.sakai@gmail.com) @@ -16,15 +16,33 @@ CHANGELOG.markdown .travis.yml Build-Type: Simple +Tested-With: + GHC ==7.4.2 + GHC ==7.6.3 + GHC ==7.8.3 source-repository head type: git location: git://github.com/msakai/sign.git +Flag lattices14 + Description: use lattices >=1.4.0 + Manual: False + Library Hs-source-dirs: src Build-Depends: - base >=4 && <5, containers >= 0.4.2, deepseq >=1.3.0.0 && <1.5.0.0, hashable >=1.1.2.5 && <1.3.0.0, lattices >=1.2.1.1 + base >=4 && <5, + containers >=0.4.2, + deepseq >=1.3.0.0 && <1.5.0.0, + hashable >=1.1.2.5 && <1.3.0.0 + if flag(lattices14) + Build-Depends: + lattices >=1.4, + universe-base + else + Build-Depends: + lattices >=1.2.1.1 && <1.4 Default-Language: Haskell2010 Other-Extensions: FlexibleInstances @@ -40,18 +58,24 @@ Build-depends: base >=4 && <5, containers, + deepseq, + lattices, sign, - test-framework, - test-framework-th, - test-framework-hunit, + tasty >=0.10.1, + tasty-hunit ==0.9.*, + tasty-quickcheck ==0.8.*, + tasty-th, -- NOTE: test-framework-quickcheck2 >=0.2.12.3 is necessary for QuickCheck >=2.5 - test-framework-quickcheck2 >=0.2.12.3 && <0.4.0, + -- test-framework-quickcheck2 >=0.2.12.3 && <0.4.0, HUnit, -- NOTE: arbitraryBoundedEnum and coarbitraryEnum exist after QuickCheck-2.5 QuickCheck >=2.5 && <3 + if flag(lattices14) + Build-Depends: universe-base Default-Language: Haskell2010 Other-Extensions: TemplateHaskell ScopedTypeVariables FlexibleInstances + CPP diff --git a/src/Data/Sign.hs b/src/Data/Sign.hs --- a/src/Data/Sign.hs +++ b/src/Data/Sign.hs @@ -35,6 +35,10 @@ import qualified Prelude as P import Prelude hiding (negate, abs, recip, div) +#if MIN_VERSION_lattices(1,4,0) +import qualified Data.Universe.Class as U -- from universe-base package +import qualified Data.Universe.Helpers as U -- from universe-base package +#endif import Algebra.Enumerable (Enumerable (..), universeBounded) -- from lattices package import qualified Algebra.Lattice as L -- from lattices package import Control.DeepSeq @@ -55,6 +59,15 @@ instance Hashable Sign where hashWithSalt = hashUsing fromEnum +#if MIN_VERSION_lattices(1,4,0) + +instance U.Universe Sign where + universe = U.universeDef + +instance U.Finite Sign + +#endif + instance Enumerable Sign where universe = universeBounded @@ -90,7 +103,9 @@ div _ Zero = error "Data.Sign.div: division by Zero" div s Neg = negate s --- | Fractional division. +-- | Exponentiation s^x. +-- +-- Note that we define @'pow' 'Zero' 0 = 'Pos'@ assuming @0^0 = 1@. pow :: Integral x => Sign -> x -> Sign pow _ 0 = Pos pow Pos _ = Pos @@ -120,6 +135,8 @@ -- Instances of 'L.Lattice' and 'L.BoundedLattice' are also provided for -- the purpose of abstract interpretation. +#if !MIN_VERSION_lattices(1,4,0) + instance L.MeetSemiLattice (Set Sign) where meet = Set.intersection @@ -129,6 +146,8 @@ top = Set.fromList universe instance L.BoundedLattice (Set Sign) + +#endif instance Num (Set Sign) where ss1 + ss2 = Set.unions [f s1 s2 | s1 <- Set.toList ss1, s2 <- Set.toList ss2] diff --git a/test/TestSign.hs b/test/TestSign.hs --- a/test/TestSign.hs +++ b/test/TestSign.hs @@ -1,21 +1,29 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, FlexibleInstances, CPP #-} +#if MIN_VERSION_lattices(1,4,0) +import Data.Universe.Class (universe) -- from universe-base package +#else +import Algebra.Enumerable (Enumerable (universe)) -- from lattices package +#endif +import qualified Algebra.Lattice as L -- from lattices package +import Control.DeepSeq +import Control.Exception import Control.Monad +import Data.Either import Data.List import Data.Maybe import Data.Ratio import qualified Data.Set as Set import Data.Set (Set) -import Test.HUnit hiding (Test) -import Test.QuickCheck -import Test.Framework (Test, defaultMain, testGroup) -import Test.Framework.TH -import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 - import qualified Data.Sign as Sign import Data.Sign (Sign (..)) +import Test.Tasty +import Test.Tasty.QuickCheck +import Test.Tasty.HUnit +import Test.Tasty.TH +import qualified Test.QuickCheck.Monadic as QM + {-------------------------------------------------------------------- Sign --------------------------------------------------------------------} @@ -79,11 +87,35 @@ b /= Zero ==> a == (a `Sign.div` b) `Sign.mult` b +case_recip_Zero = do + (ret :: Either SomeException Sign) <- try $ evaluate $ Sign.recip Zero + assertBool "Sign.recip Zero should be error" (isLeft ret) + +prop_div_Zero = QM.monadicIO $ do + a <- QM.pick arbitrary + (ret :: Either SomeException Sign) <- QM.run $ try $ evaluate $ a `Sign.div` Zero + QM.assert $ isLeft ret + prop_pow = forAll arbitrary $ \a -> forAll (choose (0, 10)) $ \(i::Int) -> Sign.pow a i == foldl' Sign.mult Pos (replicate i a) +prop_symbol = + forAll arbitrary $ \a b -> + a /= b ==> Sign.symbol a /= Sign.symbol b + +prop_Show_Read = + forAll arbitrary $ \(a :: Sign) -> + read (show a) == a + +prop_rnf = + forAll arbitrary $ \(a :: Sign) -> + rnf a == () + +prop_universe = + Set.fromList universe == Set.fromList [Neg,Zero,Pos] + {-------------------------------------------------------------------- Sign set --------------------------------------------------------------------} @@ -152,6 +184,44 @@ forAll arbitrary $ \(a :: Set Sign) -> abs (abs a) == abs a +prop_SetSign_signum_negate_comm = + forAll arbitrary $ \(a :: Set Sign) -> + signum (negate a) == negate (signum a) + +prop_SetSign_signum_abs_comm = + forAll arbitrary $ \(a :: Set Sign) -> + signum (abs a) == abs (signum a) + +prop_SetSign_fromInteger = + forAll arbitrary $ \a -> + 　case a `compare` 0 of + EQ -> fromInteger a == Set.singleton Zero + LT -> fromInteger a == Set.singleton Neg + GT -> fromInteger a == Set.singleton Pos + +prop_SetSign_fromRational = + forAll arbitrary $ \a -> + 　case a `compare` 0 of + EQ -> fromRational a == Set.singleton Zero + LT -> fromRational a == Set.singleton Neg + GT -> fromRational a == Set.singleton Pos + +prop_SetSign_recip_involution = + forAll arbitrary $ \(a :: Set Sign) -> + Zero `Set.notMember` a ==> recip (recip a) == a + +prop_SetSign_Lattice_top = + forAll arbitrary $ \(a :: Set Sign) -> + a `Set.isSubsetOf` L.top + +prop_SetSign_Lattice_bottom = + forAll arbitrary $ \(a :: Set Sign) -> + L.bottom `Set.isSubsetOf` a + +prop_SetSign_Lattice_Leq_welldefined = + forAll arbitrary $ \(a :: Set Sign) b -> + a `L.meetLeq` b == a `L.joinLeq` b + prop_SetSign_pow = forAll arbitrary $ \a -> forAll (choose (0, 10)) $ \(i::Int) -> @@ -189,3 +259,15 @@ main :: IO () main = $(defaultMainGenerator) + +#if !MIN_VERSION_base(4,7,0) + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False + +isRight :: Either a b -> Bool +isRight (Left _) = False +isRight (Right _) = True + +#endif