diff --git a/Data/Digest/Adler32.hsc b/Data/Digest/Adler32.hsc --- a/Data/Digest/Adler32.hsc +++ b/Data/Digest/Adler32.hsc @@ -16,15 +16,13 @@ Adler32, adler32, adler32Update ) where +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Foreign -import Foreign.C.Types -import Foreign.ForeignPtr () -import GHC.Ptr () import qualified Data.ByteString as S -import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as LI +import qualified System.IO.Unsafe as U #include "zlib.h" @@ -50,15 +48,20 @@ adler32_s_update :: Word32 -> S.ByteString -> Word32 -adler32_s_update n s = adler32_l_update n (LI.Chunk s LI.Empty) +adler32_s_update seed str + | S.null str = seed + | otherwise = + U.unsafePerformIO $ + unsafeUseAsCStringLen str $ + \(buf, len) -> fmap fromIntegral $ + adler32_c (fromIntegral seed) (castPtr buf) (fromIntegral len) adler32_l_update :: Word32 -> L.ByteString -> Word32 -adler32_l_update n = LI.foldlChunks updateAdler n - where updateAdler adler bs = fromIntegral $ adler32_c (fromIntegral adler) buf (fromIntegral len) - where (ptr, offset, len) = BI.toForeignPtr bs - buf = (unsafeForeignPtrToPtr ptr) `plusPtr` offset - -foreign import ccall unsafe "zlib.h adler32" - adler32_c :: CInt -> Ptr Word8 -> CInt -> CInt -- adler, buf, len -> adler' +adler32_l_update = LI.foldlChunks adler32_s_update +foreign import ccall unsafe "zlib.h adler32" + adler32_c :: #{type uLong} + -> Ptr #{type Bytef} + -> #{type uInt} + -> IO #{type uLong} diff --git a/Data/Digest/CRC32.hsc b/Data/Digest/CRC32.hsc --- a/Data/Digest/CRC32.hsc +++ b/Data/Digest/CRC32.hsc @@ -16,15 +16,13 @@ CRC32, crc32, crc32Update ) where +import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import Foreign -import Foreign.C.Types -import Foreign.ForeignPtr () -import GHC.Ptr () import qualified Data.ByteString as S -import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Internal as LI +import qualified System.IO.Unsafe as U #include "zlib.h" @@ -50,15 +48,21 @@ crc32_s_update :: Word32 -> S.ByteString -> Word32 -crc32_s_update n s = crc32_l_update n (LI.Chunk s LI.Empty) +crc32_s_update seed str + | S.null str = seed + | otherwise = + U.unsafePerformIO $ + unsafeUseAsCStringLen str $ + \(buf, len) -> fmap fromIntegral $ + crc32_c (fromIntegral seed) (castPtr buf) (fromIntegral len) crc32_l_update :: Word32 -> L.ByteString -> Word32 -crc32_l_update n = LI.foldlChunks updateCRC n - where updateCRC crc bs = fromIntegral $ crc32_c (fromIntegral crc) buf (fromIntegral len) - where (ptr, offset, len) = BI.toForeignPtr bs - buf = (unsafeForeignPtrToPtr ptr) `plusPtr` offset +crc32_l_update = LI.foldlChunks crc32_s_update -foreign import ccall unsafe "zlib.h crc32" - crc32_c :: CInt -> Ptr Word8 -> CInt -> CInt -- crc, buf, len -> crc' +foreign import ccall unsafe "zlib.h crc32" + crc32_c :: #{type uLong} + -> Ptr #{type Bytef} + -> #{type uInt} + -> IO #{type uLong} diff --git a/digest.cabal b/digest.cabal --- a/digest.cabal +++ b/digest.cabal @@ -1,5 +1,5 @@ name: digest -version: 0.0.1.0 +version: 0.0.1.1 copyright: (c) 2009 Eugene Kirpichov license: BSD3 license-file: LICENSE @@ -13,6 +13,12 @@ stability: provisional build-type: Simple cabal-version: >= 1.6 + +extra-source-files: + testing/trivial-reference.c + testing/trivial.expected + testing/trivial.hs + flag bytestring-in-base description: In the ghc-6.6 era the bytestring modules were included in the base package. diff --git a/testing/trivial-reference.c b/testing/trivial-reference.c new file mode 100644 --- /dev/null +++ b/testing/trivial-reference.c @@ -0,0 +1,49 @@ +#include +#include + +typedef uLong HashFunc(uLong seed, const Bytef *buf, uInt len); + +static void printHash(uLong hash) +{ + printf(" %lu\n", (unsigned long) hash); +} + +static void runTest(const char *label, HashFunc func, uLong seed) +{ + printf("%s\n", label); + + printHash(func(seed, (const Bytef *)"", 0)); + printHash(func(seed, (const Bytef *)"", 0)); + printHash(func(seed, (const Bytef *)"\0", 1)); + printHash(func(seed, (const Bytef *)"a", 1)); + printHash(func(seed, (const Bytef *)"hello", 5)); + + { + int i; + unsigned char buffer[300]; + + for (i = 0; i <= 255; i++) + buffer[i] = i; + + printHash(func(seed, buffer, 256)); + } + + puts(""); +} + +int main(void) +{ + runTest("adler32", adler32, 1); + runTest("adler32Update 0", adler32, 0); + runTest("adler32Update 1", adler32, 1); + runTest("adler32Update 123", adler32, 123); + runTest("adler32Update 0xFFF0FFF0", adler32, 0xFFF0FFF0); + + runTest("crc32", crc32, 0); + runTest("crc32Update 0", crc32, 0); + runTest("crc32Update 1", crc32, 1); + runTest("crc32Update 123", crc32, 123); + runTest("crc32Update 0xFFFFFFFF", crc32, 0xFFFFFFFF); + + return 0; +} diff --git a/testing/trivial.expected b/testing/trivial.expected new file mode 100644 --- /dev/null +++ b/testing/trivial.expected @@ -0,0 +1,80 @@ +adler32 + 1 + 1 + 65537 + 6422626 + 103547413 + 2918612865 + +adler32Update 0 + 0 + 0 + 0 + 6357089 + 103219732 + 2901835648 + +adler32Update 1 + 1 + 1 + 65537 + 6422626 + 103547413 + 2918612865 + +adler32Update 123 + 123 + 123 + 8061051 + 14418140 + 143524495 + 671449083 + +adler32Update 0xFFF0FFF0 + 4293984240 + 4293984240 + 4293918704 + 6226016 + 102826515 + 2884992895 + +crc32 + 0 + 0 + 3523407757 + 3904355907 + 907060870 + 688229491 + +crc32Update 0 + 0 + 0 + 3523407757 + 3904355907 + 907060870 + 688229491 + +crc32Update 1 + 1 + 1 + 2768625435 + 2679148245 + 191926070 + 3879140792 + +crc32Update 123 + 123 + 123 + 366298937 + 794826487 + 3088217944 + 398094930 + +crc32Update 0xFFFFFFFF + 4294967295 + 4294967295 + 4294967295 + 3310005809 + 265137764 + 3681351380 + diff --git a/testing/trivial.hs b/testing/trivial.hs new file mode 100644 --- /dev/null +++ b/testing/trivial.hs @@ -0,0 +1,52 @@ +import Data.Digest.Adler32 +import Data.Digest.CRC32 + +import Control.Monad (forM_) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 (pack) +import Data.Word (Word32) +import Foreign.ForeignPtr (mallocForeignPtr) +import System.IO.Unsafe (unsafePerformIO) + +import qualified Data.ByteString.Internal as I + +-- | Empty 'ByteString' whose pointer is null +emptyNull :: ByteString +emptyNull = I.PS I.nullForeignPtr 0 0 + +-- | Empty 'ByteString' whose pointer is not null +emptyNotNull :: ByteString +emptyNotNull = unsafePerformIO $ do + ptr <- mallocForeignPtr + return $ I.PS ptr 0 0 + +testStrings :: [ByteString] +testStrings = + [ emptyNull + , emptyNotNull + , pack "\0" + , pack "a" + , pack "hello" + , pack ['\0'..'\255'] + ] + +runTest :: String -> (ByteString -> Word32) -> IO () +runTest label func = do + putStrLn label + forM_ testStrings $ \s -> + putStrLn $ " " ++ (show . func) s + putStrLn "" + +main :: IO () +main = do + runTest "adler32" $ adler32 + runTest "adler32Update 0" $ adler32Update 0 + runTest "adler32Update 1" $ adler32Update 1 + runTest "adler32Update 123" $ adler32Update 123 + runTest "adler32Update 0xFFF0FFF0" $ adler32Update 0xFFF0FFF0 + + runTest "crc32" $ crc32 + runTest "crc32Update 0" $ crc32Update 0 + runTest "crc32Update 1" $ crc32Update 1 + runTest "crc32Update 123" $ crc32Update 123 + runTest "crc32Update 0xFFFFFFFF" $ crc32Update 0xFFFFFFFF