diff --git a/bv-sized.cabal b/bv-sized.cabal --- a/bv-sized.cabal +++ b/bv-sized.cabal @@ -1,10 +1,9 @@ name: bv-sized -version: 1.0.0 +version: 1.0.1 category: Bit Vectors -synopsis: a BitVector datatype that is parameterized by the vector width +synopsis: a bitvector datatype that is parameterized by the vector width description: - This module defines a width-parameterized 'BitVector' type and various associated - operations that assume a 2's complement representation. + This module defines a width-parameterized bitvector type and various associated operations. extra-source-files: changelog.md homepage: https://github.com/GaloisInc/bv-sized license: BSD3 @@ -29,9 +28,9 @@ Data.BitVector.Sized.Panic build-depends: base >= 4.10 && <5, bitwise >= 1.0.0 && < 1.1, - bytestring >= 0.10.10 && < 0.11, + bytestring >= 0.10 && < 0.11, panic >= 0.4.0 && < 0.5, - parameterized-utils >= 2.0.2 && < 2.1, + parameterized-utils >= 2.0.2 && < 2.2, th-lift >= 0.8.1 && < 0.9 hs-source-dirs: src default-language: Haskell2010 @@ -41,11 +40,11 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs - build-depends: base >= 4.7 && < 5, + build-depends: base, bv-sized, - bytestring >= 0.10.10 && < 0.11, - hedgehog >= 1.0.2 && < 1.1, - parameterized-utils >= 2.0.2 && < 2.1, + bytestring, + hedgehog, + parameterized-utils, tasty >= 1.2.3 && < 1.3, tasty-hedgehog >= 1.0.0.2 && < 1.1 default-language: Haskell2010 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Changelog for [`bv-sized` package](http://hackage.haskell.org/package/bv-sized) +## 1.0.1 *May 2020* + +This fixed a subtle bug in the test suite which occasionally caused a +divide by zero exception. + ## 1.0.0 *May 2020* This is a completely breaking change and it is completely incompatible diff --git a/src/Data/BitVector/Sized/Internal.hs b/src/Data/BitVector/Sized/Internal.hs --- a/src/Data/BitVector/Sized/Internal.hs +++ b/src/Data/BitVector/Sized/Internal.hs @@ -94,7 +94,15 @@ -- has a width whose value is representable in a Haskell @Int@. BV :: Integer -> BV w - deriving (Generic, Show, Read, Eq, Ord, Lift) + deriving ( Generic + , Show + , Read + , Eq + , Ord -- ^ Uses an unsigned ordering, but 'ule' and 'ult' are + -- preferred. We provide this instance to allow the use of 'BV' + -- in situations where an arbitrary ordering is required (e.g., + -- as the keys in a map) + , Lift) instance ShowF BV diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -18,6 +18,7 @@ import qualified Data.BitVector.Sized as BV -- Auxiliary modules +import qualified Data.Bits as Bits import qualified Data.ByteString as BS import Data.Maybe (isJust, fromJust) import Data.Parameterized.NatRepr @@ -80,7 +81,7 @@ let pa1 = p w a1 let pa2 = p w a2 let pa1_pa2 = bOp w pa1 pa2 - + pa1_a2 === pa1_pa2 binPred :: Show a @@ -107,7 +108,7 @@ let pa1 = p w a1 let pa2 = p w a2 let pa1_pa2 = bPred w pa1 pa2 - + a1_a2 === pa1_pa2 ---------------------------------------- @@ -172,6 +173,22 @@ ---------------------------------------- -- Tests +bitwiseHomTests :: TestTree +bitwiseHomTests = testGroup "bitwise homomorphisms tests" + [ testProperty "and" $ bin anyWidth BV.mkBV + largeUnsigned largeUnsigned + (const (Bits..&.)) (const BV.and) + , testProperty "or" $ bin anyWidth BV.mkBV + largeUnsigned largeUnsigned + (const (Bits..|.)) (const BV.or) + , testProperty "xor" $ bin anyWidth BV.mkBV + largeUnsigned largeUnsigned + (const Bits.xor) (const BV.xor) + , testProperty "complement" $ un anyWidth BV.mkBV + largeUnsigned + (const Bits.complement) BV.complement + ] + arithHomTests :: TestTree arithHomTests = testGroup "arithmetic homomorphisms tests" [ testProperty "add" $ bin anyWidth BV.mkBV @@ -192,25 +209,25 @@ , testProperty "squot-pos-denom" $ bin anyWidthGT1 BV.mkBV signed signedPos (const quot) (forcePos BV.squot) - , testProperty "squot-neg-denom" $ bin anyPosWidth BV.mkBV + , testProperty "squot-neg-denom" $ bin anyWidthGT1 BV.mkBV signed signedNeg (const quot) (forcePos BV.squot) - , testProperty "srem-pos-denom" $ bin anyPosWidth BV.mkBV + , testProperty "srem-pos-denom" $ bin anyWidthGT1 BV.mkBV signed signedPos (const rem) (forcePos BV.srem) - , testProperty "srem-neg-denom" $ bin anyPosWidth BV.mkBV + , testProperty "srem-neg-denom" $ bin anyWidthGT1 BV.mkBV signed signedNeg (const rem) (forcePos BV.srem) - , testProperty "sdiv-pos-denom" $ bin anyPosWidth BV.mkBV + , testProperty "sdiv-pos-denom" $ bin anyWidthGT1 BV.mkBV signed signedPos (const div) (forcePos BV.sdiv) - , testProperty "sdiv-neg-denom" $ bin anyPosWidth BV.mkBV + , testProperty "sdiv-neg-denom" $ bin anyWidthGT1 BV.mkBV signed signedNeg (const div) (forcePos BV.sdiv) - , testProperty "smod-pos-denom" $ bin anyPosWidth BV.mkBV + , testProperty "smod-pos-denom" $ bin anyWidthGT1 BV.mkBV signed signedPos (const mod) (forcePos BV.smod) - , testProperty "smod-neg-denom" $ bin anyPosWidth BV.mkBV + , testProperty "smod-neg-denom" $ bin anyWidthGT1 BV.mkBV signed signedNeg (const mod) (forcePos BV.smod) , testProperty "abs" $ un anyPosWidth BV.mkBV @@ -222,6 +239,9 @@ , testProperty "signBit" $ un anyPosWidth BV.mkBV signed (\_ a -> if a < 0 then 1 else 0) (forcePos BV.signBit) + , testProperty "signum" $ un anyPosWidth BV.mkBV + signed + (\_ a -> signum a) (forcePos BV.signum) , testProperty "slt" $ binPred anyPosWidth BV.mkBV signed signed (const (<)) (forcePos BV.slt) @@ -240,6 +260,12 @@ , testProperty "umax" $ bin anyWidth BV.mkBV unsigned unsigned (const max) (const BV.umax) + , testProperty "smin" $ bin anyPosWidth BV.mkBV + signed signed + (const min) (forcePos BV.smin) + , testProperty "smax" $ bin anyPosWidth BV.mkBV + signed signed + (const max) (forcePos BV.smax) ] serdeTest :: Gen (Some NatRepr) @@ -311,6 +337,7 @@ tests :: TestTree tests = testGroup "bv-sized tests" [ arithHomTests + , bitwiseHomTests , serdeTests , deserTests ]