hashable 1.2.0.5 → 1.2.0.6
raw patch · 6 files changed
+139/−17 lines, 6 filesdep +HUnitdep +QuickCheckdep +criteriondep ~basedep ~bytestringdep ~textnew-uploader
Dependencies added: HUnit, QuickCheck, criterion, hashable, random, siphash, test-framework, test-framework-hunit, test-framework-quickcheck2, unix
Dependency ranges changed: base, bytestring, text
Files
- cbits/siphash-sse2.c +22/−2
- hashable.cabal +9/−2
- tests/Main.hs +14/−0
- tests/Properties.hs +6/−13
- tests/Regress.hs +15/−0
- tests/Regress/Mmap.hsc +73/−0
cbits/siphash-sse2.c view
@@ -18,6 +18,7 @@ __m128i mi, mask, len; size_t i, k; union { u64 gpr; __m128i xmm; } hash;+ const u8 *p; /* We used to use the _mm_seti_epi32 intrinsic to initialize SSE2 registers. This compiles to a movdqa instruction,@@ -76,7 +77,26 @@ v0 = _mm_xor_si128(v0, mi); } - mi = _mm_loadl_epi64((__m128i*)(m + i));+ p = m + n;++ /* We must be careful to not trigger a segfault by reading an+ unmapped page. So where is the end of our input? */++ if (((uintptr_t) p & 4095) == 0)+ /* Exactly at a page boundary: do not read past the end. */+ mi = _mm_setzero_si128();+ else if (((uintptr_t) p & 4095) <= 4088)+ /* Inside a page: safe to read past the end, as we'll+ mask out any bits we shouldn't have looked at below. */+ mi = _mm_loadl_epi64((__m128i*)(m + i));+ else+ /* Within 8 bytes of the end of a page: ensure that+ our final read re-reads some bytes so that we do+ not cross the page boundary, then shift our result+ right so that the re-read bytes vanish. */+ mi = _mm_srli_epi64(_mm_loadl_epi64((__m128i*)(((uintptr_t) m + i) & ~7)),+ 8 * (((uintptr_t) m + i) % 8));+ len = _mm_set_epi32(0, 0, (n&0xff) << 24, 0); mask = _mm_srli_epi64(_mm_loadu_si128((__m128i*) &iv[4]), 8*(8-n%8)); mi = _mm_xor_si128(_mm_and_si128(mi, mask), len);@@ -84,7 +104,7 @@ v3 = _mm_xor_si128(v3, mi); if (SIPHASH_ROUNDS == 2) { COMPRESS(v0,v1,v2,v3); COMPRESS(v0,v1,v2,v3);- } else { + } else { for (k = 0; k < SIPHASH_ROUNDS; ++k) COMPRESS(v0,v1,v2,v3); }
hashable.cabal view
@@ -1,5 +1,5 @@ Name: hashable-Version: 1.2.0.5+Version: 1.2.0.6 Synopsis: A class for types that can be converted to a hash value Description: This package defines a class, 'Hashable', for types that can be converted to a hash value. This class@@ -74,16 +74,23 @@ Test-suite tests Type: exitcode-stdio-1.0 Hs-source-dirs: tests- Main-is: Properties.hs+ Main-is: Main.hs+ Other-modules: Properties Regress Build-depends: base >= 4.0 && < 5.0, bytestring, ghc-prim, hashable, test-framework >= 0.3.3,+ test-framework-hunit, test-framework-quickcheck2 >= 0.2.9,+ HUnit, QuickCheck >= 2.4.0.1, random == 1.0.*, text >= 0.11.0.5+ if !os(windows)+ Build-depends: unix+ CPP-options: -DHAVE_MMAP+ Other-modules: Regress.Mmap Ghc-options: -Wall -fno-warn-orphans if impl(ghc >= 7.2.1)
+ tests/Main.hs view
@@ -0,0 +1,14 @@+-- | Tests for the 'Data.Hashable' module. We test functions by+-- comparing the C and Haskell implementations.++module Main (main) where++import Properties (properties)+import Regress (regressions)+import Test.Framework (defaultMain, testGroup)++main :: IO ()+main = defaultMain [+ testGroup "properties" properties+ , testGroup "regressions" regressions+ ]
tests/Properties.hs view
@@ -4,10 +4,10 @@ {-# LANGUAGE DeriveGeneric, ScopedTypeVariables #-} #endif --- | Tests for the 'Data.Hashable' module. We test functions by--- comparing the C and Haskell implementations.+-- | QuickCheck tests for the 'Data.Hashable' module. We test+-- functions by comparing the C and Haskell implementations. -module Main (main) where+module Properties (properties) where import Data.Hashable (Hashable, hash, hashByteArray, hashPtr) import qualified Data.ByteString as B@@ -23,7 +23,7 @@ import GHC.ST (ST(..), runST) import GHC.Word (Word8(..)) import Test.QuickCheck hiding ((.&.))-import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) #ifdef GENERICS import GHC.Generics@@ -193,14 +193,8 @@ #endif ---------------------------------------------------------------------------- Test harness--main :: IO ()-main = defaultMain tests--tests :: [Test]-tests =+properties :: [Test]+properties = [ testProperty "bernstein" pHash , testGroup "text" [ testProperty "text/strict" pText@@ -234,4 +228,3 @@ #else fromStrict b = BL.fromChunks [b] #endif-
+ tests/Regress.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module Regress (regressions) where++import qualified Test.Framework as F++#ifdef HAVE_MMAP+import qualified Regress.Mmap as Mmap+#endif++regressions :: [F.Test]+regressions = []+#ifdef HAVE_MMAP+ ++ Mmap.regressions+#endif
+ tests/Regress/Mmap.hsc view
@@ -0,0 +1,73 @@+{-# LANGUAGE ForeignFunctionInterface #-}++module Regress.Mmap (regressions) where++#include <sys/mman.h>++import Control.Exception (bracket, evaluate)+import Control.Monad (forM_)+import Data.Bits ((.|.))+import Data.ByteString.Internal (ByteString(..))+import Data.Hashable (hash)+import Foreign.C.Error (throwErrnoIf, throwErrnoIfMinus1, throwErrnoIfMinus1_)+import Foreign.C.Types (CInt(..), CSize(..))+import Foreign.Ptr (Ptr, intPtrToPtr, nullPtr, plusPtr)+import GHC.ForeignPtr (newForeignPtr_)+import System.Posix.Types (COff(..))+import Test.Framework (Test)+import Test.Framework.Providers.HUnit (testCase)+import qualified Data.ByteString as B++withMapping :: (Ptr a -> Int -> IO ()) -> IO ()+withMapping go = do+ pageSize <- fromIntegral `fmap` getPageSize+ let mappingSize = pageSize * 2+ bracket (mmap+ nullPtr+ mappingSize+ ((#const PROT_READ) .|. (#const PROT_WRITE))+ ((#const MAP_ANON) .|. (#const MAP_PRIVATE))+ (-1)+ 0)+ (flip munmap mappingSize) $ \mappingPtr -> do+ go mappingPtr (fromIntegral pageSize)+ mprotect (mappingPtr `plusPtr` fromIntegral pageSize)+ pageSize (#const PROT_NONE)++hashNearPageBoundary :: IO ()+hashNearPageBoundary =+ withMapping $ \ptr pageSize -> do+ let initialSize = 16+ fp <- newForeignPtr_ (ptr `plusPtr` (pageSize - initialSize))+ let bs0 = PS fp 0 initialSize+ forM_ (B.tails bs0) $ \bs -> do+ evaluate (hash bs)++regressions :: [Test]+regressions = [+ testCase "hashNearPageBoundary" hashNearPageBoundary+ ]++mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)+mmap addr len prot flags fd offset =+ throwErrnoIf (== intPtrToPtr (#const MAP_FAILED)) "mmap" $+ c_mmap addr len prot flags fd offset++munmap :: Ptr a -> CSize -> IO CInt+munmap addr len = throwErrnoIfMinus1 "munmap" $ c_munmap addr len++mprotect :: Ptr a -> CSize -> CInt -> IO ()+mprotect addr len prot =+ throwErrnoIfMinus1_ "mprotect" $ c_mprotect addr len prot++foreign import ccall unsafe "sys/mman.h mmap"+ c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)++foreign import ccall unsafe "sys/mman.h munmap"+ c_munmap :: Ptr a -> CSize -> IO CInt++foreign import ccall unsafe "sys/mman.h mprotect"+ c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt++foreign import ccall unsafe "unistd.h getpagesize"+ getPageSize :: IO CInt