diff --git a/Codec/Compression/Zlib/Internal.hs b/Codec/Compression/Zlib/Internal.hs --- a/Codec/Compression/Zlib/Internal.hs +++ b/Codec/Compression/Zlib/Internal.hs @@ -1,8 +1,10 @@ {-# LANGUAGE CPP, RankNTypes, DeriveDataTypeable, BangPatterns #-} +#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} +#endif ----------------------------------------------------------------------------- -- | --- Copyright : (c) 2006-2014 Duncan Coutts +-- Copyright : (c) 2006-2015 Duncan Coutts -- License : BSD-style -- -- Maintainer : duncan@community.haskell.org diff --git a/Codec/Compression/Zlib/Stream.hsc b/Codec/Compression/Zlib/Stream.hsc --- a/Codec/Compression/Zlib/Stream.hsc +++ b/Codec/Compression/Zlib/Stream.hsc @@ -1,7 +1,10 @@ -{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, DeriveGeneric #-} +{-# LANGUAGE CPP, ForeignFunctionInterface, DeriveDataTypeable #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE DeriveGeneric #-} +#endif ----------------------------------------------------------------------------- -- | --- Copyright : (c) 2006-2014 Duncan Coutts +-- Copyright : (c) 2006-2015 Duncan Coutts -- License : BSD-style -- -- Maintainer : duncan@community.haskell.org @@ -93,7 +96,7 @@ ( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff , ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer , withForeignPtr, touchForeignPtr, minusPtr ) -#if __GLASGOW_HASKELL__ >= 702 +#if MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr ) import System.IO.Unsafe ( unsafePerformIO ) #else @@ -107,17 +110,25 @@ import Data.ByteString.Internal (nullForeignPtr) import qualified Data.ByteString.Unsafe as B import Data.ByteString (ByteString) +#if !(MIN_VERSION_base(4,8,0)) import Control.Applicative (Applicative(..)) +#endif import Control.Monad (ap,liftM) -#if __GLASGOW_HASKELL__ >= 702 +#if MIN_VERSION_base(4,4,0) +#if MIN_VERSION_base(4,7,0) +import Control.Monad.ST.Strict +#else import Control.Monad.ST.Strict hiding (unsafeIOToST) +#endif import Control.Monad.ST.Unsafe #else import Control.Monad.ST.Strict #endif import Control.Exception (assert) import Data.Typeable (Typeable) +#if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) +#endif #ifdef DEBUG import System.IO (hPutStrLn, stderr) #endif @@ -545,7 +556,11 @@ -- variations. -- data Format = GZip | Zlib | Raw | GZipOrZlib - deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Generic) + deriving (Eq, Ord, Enum, Bounded, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {-# DEPRECATED GZip "Use gzipFormat. Format constructors will be hidden in version 0.7" #-} {-# DEPRECATED Zlib "Use zlibFormat. Format constructors will be hidden in version 0.7" #-} @@ -590,7 +605,11 @@ -- | The compression method -- data Method = Deflated - deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Generic) + deriving (Eq, Ord, Enum, Bounded, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {-# DEPRECATED Deflated "Use deflateMethod. Method constructors will be hidden in version 0.7" #-} @@ -614,7 +633,11 @@ | BestSpeed | BestCompression | CompressionLevel Int - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {-# DEPRECATED DefaultCompression "Use defaultCompression. CompressionLevel constructors will be hidden in version 0.7" #-} {-# DEPRECATED NoCompression "Use noCompression. CompressionLevel constructors will be hidden in version 0.7" #-} @@ -674,7 +697,11 @@ -- is defined with and used by the tests. -- It makse sense because the default value -- is is also the max value at 15. - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {-# DEPRECATED DefaultWindowBits "Use defaultWindowBits. WindowBits constructors will be hidden in version 0.7" #-} --FIXME: cannot deprecate constructor named the same as the type @@ -730,7 +757,11 @@ | MinMemoryLevel | MaxMemoryLevel | MemoryLevel Int - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {-# DEPRECATED DefaultMemoryLevel "Use defaultMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-} {-# DEPRECATED MinMemoryLevel "Use minMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-} @@ -780,7 +811,11 @@ DefaultStrategy | Filtered | HuffmanOnly - deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Generic) + deriving (Eq, Ord, Enum, Bounded, Show, Typeable +#if __GLASGOW_HASKELL__ >= 702 + , Generic +#endif + ) {- -- -- only available in zlib 1.2 and later, uncomment if you need it. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2006-2008, Duncan Coutts +Copyright (c) 2006-2015, Duncan Coutts All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/cbits/gzguts.h b/cbits/gzguts.h new file mode 100644 --- /dev/null +++ b/cbits/gzguts.h @@ -0,0 +1,209 @@ +/* gzguts.h -- zlib internal header definitions for gz* operations + * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +#ifdef _LARGEFILE64_SOURCE +# ifndef _LARGEFILE_SOURCE +# define _LARGEFILE_SOURCE 1 +# endif +# ifdef _FILE_OFFSET_BITS +# undef _FILE_OFFSET_BITS +# endif +#endif + +#ifdef HAVE_HIDDEN +# define ZLIB_INTERNAL __attribute__((visibility ("hidden"))) +#else +# define ZLIB_INTERNAL +#endif + +#include +#include "zlib.h" +#ifdef STDC +# include +# include +# include +#endif +#include + +#ifdef _WIN32 +# include +#endif + +#if defined(__TURBOC__) || defined(_MSC_VER) || defined(_WIN32) +# include +#endif + +#ifdef WINAPI_FAMILY +# define open _open +# define read _read +# define write _write +# define close _close +#endif + +#ifdef NO_DEFLATE /* for compatibility with old definition */ +# define NO_GZCOMPRESS +#endif + +#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif + +#if defined(__CYGWIN__) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif + +#if defined(MSDOS) && defined(__BORLANDC__) && (BORLANDC > 0x410) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif + +#ifndef HAVE_VSNPRINTF +# ifdef MSDOS +/* vsnprintf may exist on some MS-DOS compilers (DJGPP?), + but for now we just assume it doesn't. */ +# define NO_vsnprintf +# endif +# ifdef __TURBOC__ +# define NO_vsnprintf +# endif +# ifdef WIN32 +/* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +# if !defined(vsnprintf) && !defined(NO_vsnprintf) +# if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 ) +# define vsnprintf _vsnprintf +# endif +# endif +# endif +# ifdef __SASC +# define NO_vsnprintf +# endif +# ifdef VMS +# define NO_vsnprintf +# endif +# ifdef __OS400__ +# define NO_vsnprintf +# endif +# ifdef __MVS__ +# define NO_vsnprintf +# endif +#endif + +/* unlike snprintf (which is required in C99, yet still not supported by + Microsoft more than a decade later!), _snprintf does not guarantee null + termination of the result -- however this is only used in gzlib.c where + the result is assured to fit in the space provided */ +#ifdef _MSC_VER +# define snprintf _snprintf +#endif + +#ifndef local +# define local static +#endif +/* compile with -Dlocal if your debugger can't find static symbols */ + +/* gz* functions always use library allocation functions */ +#ifndef STDC + extern voidp malloc OF((uInt size)); + extern void free OF((voidpf ptr)); +#endif + +/* get errno and strerror definition */ +#if defined UNDER_CE +# include +# define zstrerror() gz_strwinerror((DWORD)GetLastError()) +#else +# ifndef NO_STRERROR +# include +# define zstrerror() strerror(errno) +# else +# define zstrerror() "stdio error (consult errno)" +# endif +#endif + +/* provide prototypes for these when building zlib without LFS */ +#if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0 + ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *)); + ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int)); + ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile)); + ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile)); +#endif + +/* default memLevel */ +#if MAX_MEM_LEVEL >= 8 +# define DEF_MEM_LEVEL 8 +#else +# define DEF_MEM_LEVEL MAX_MEM_LEVEL +#endif + +/* default i/o buffer size -- double this for output when reading (this and + twice this must be able to fit in an unsigned type) */ +#define GZBUFSIZE 8192 + +/* gzip modes, also provide a little integrity check on the passed structure */ +#define GZ_NONE 0 +#define GZ_READ 7247 +#define GZ_WRITE 31153 +#define GZ_APPEND 1 /* mode set to GZ_WRITE after the file is opened */ + +/* values for gz_state how */ +#define LOOK 0 /* look for a gzip header */ +#define COPY 1 /* copy input directly */ +#define GZIP 2 /* decompress a gzip stream */ + +/* internal gzip file state data structure */ +typedef struct { + /* exposed contents for gzgetc() macro */ + struct gzFile_s x; /* "x" for exposed */ + /* x.have: number of bytes available at x.next */ + /* x.next: next output data to deliver or write */ + /* x.pos: current position in uncompressed data */ + /* used for both reading and writing */ + int mode; /* see gzip modes above */ + int fd; /* file descriptor */ + char *path; /* path or fd for error messages */ + unsigned size; /* buffer size, zero if not allocated yet */ + unsigned want; /* requested buffer size, default is GZBUFSIZE */ + unsigned char *in; /* input buffer */ + unsigned char *out; /* output buffer (double-sized when reading) */ + int direct; /* 0 if processing gzip, 1 if transparent */ + /* just for reading */ + int how; /* 0: get header, 1: copy, 2: decompress */ + z_off64_t start; /* where the gzip data started, for rewinding */ + int eof; /* true if end of input file reached */ + int past; /* true if read requested past end */ + /* just for writing */ + int level; /* compression level */ + int strategy; /* compression strategy */ + /* seek request */ + z_off64_t skip; /* amount to skip (already rewound if backwards) */ + int seek; /* true if seek request pending */ + /* error information */ + int err; /* error code */ + char *msg; /* error message */ + /* zlib inflate or deflate stream */ + z_stream strm; /* stream structure in-place (not a pointer) */ +} gz_state; +typedef gz_state FAR *gz_statep; + +/* shared functions */ +void ZLIB_INTERNAL gz_error OF((gz_statep, int, const char *)); +#if defined UNDER_CE +char ZLIB_INTERNAL *gz_strwinerror OF((DWORD error)); +#endif + +/* GT_OFF(x), where x is an unsigned value, is true if x > maximum z_off64_t + value -- needed when comparing unsigned to z_off64_t, which is signed + (possible z_off64_t types off_t, off64_t, and long are all signed) */ +#ifdef INT_MAX +# define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > INT_MAX) +#else +unsigned ZLIB_INTERNAL gz_intmax OF((void)); +# define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > gz_intmax()) +#endif diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,27 @@ +0.6.0.1 Duncan Coutts April 2015 + + * Fixed building with older GHC + * Fixed warnings with new GHC + * Fixed building on Windows + * Fixed testsuite + +0.6.0.0 Duncan Coutts April 2015 + + * New incremental interface for compression and decompression + * Provide access to unconsumed trailing data + * Simplified structured error type, and instance of Exception + * Updated bundled zlib C code to 1.2.8 (used on Windows) + * Fixed memory leak of zlib z_stream C structure + * More derivied instances (Eq, Show, Typeable, Generic) + +0.5.4.2 Duncan Coutts November 2014 + + * Builds with GHC 7.10 + +0.5.4.1 Duncan Coutts February 2013 + + * Force tail of input when finished decompressing, to help lazy IO + +0.5.4.0 Duncan Coutts September 2012 + + * New support for zlib custom dictionaries diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} module Main where @@ -24,9 +23,12 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import System.IO +#if !(MIN_VERSION_base(4,6,0)) import Prelude hiding (catch) +#endif + main :: IO () main = defaultMain $ testGroup "zlib tests" [ @@ -77,6 +79,7 @@ -> DecompressParams -> Property prop_gziporzlib2 cp dp = + decompressWindowBits dp >= compressWindowBits cp && decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> liftM2 (==) (decompress gzipOrZlibFormat dp . compress gzipFormat cp) id @@ -160,13 +163,13 @@ dict <- readSampleData "custom-dict.zlib-dict" let decomp = decompressIO zlibFormat defaultDecompressParams { decompressDictionary = - Just (BL.toStrict dict) + Just (toStrict dict) } assertDecompressOk hnd decomp test_trailing_data :: Assertion test_trailing_data = - withSampleData "two-files.gzip" $ \hnd -> do + withSampleData "two-files.gz" $ \hnd -> do let decomp = decompressIO gzipFormat defaultDecompressParams chunks <- assertDecompressOkChunks hnd decomp case chunks of @@ -202,6 +205,12 @@ msg <- assertDataFormatError err msg @?= "incorrect data check" +toStrict :: BL.ByteString -> BS.ByteString +#if MIN_VERSION_bytestring(0,10,0) +toStrict = BL.toStrict +#else +toStrict = BS.concat . BL.toChunks +#endif -------------- -- HUnit Utils diff --git a/test/Test/Codec/Compression/Zlib/Internal.hs b/test/Test/Codec/Compression/Zlib/Internal.hs --- a/test/Test/Codec/Compression/Zlib/Internal.hs +++ b/test/Test/Codec/Compression/Zlib/Internal.hs @@ -9,7 +9,7 @@ import Test.Codec.Compression.Zlib.Stream () import Test.QuickCheck -import Control.Monad (ap, msum) +import Control.Monad (ap) deriving instance Show CompressParams @@ -20,24 +20,6 @@ `ap` arbitrary `ap` arbitraryBufferSize `ap` return Nothing - -- this definition (and the equivalent in DecompressParams below) could be - -- made nicer using Data.Accessor, but it's probably not worth the - -- dependency - shrink cp = msum [ - return (\lv -> cp { compressLevel = lv }) `ap` - shrink (compressLevel cp), - return (\mt -> cp { compressMethod = mt }) `ap` - shrink (compressMethod cp), - return (\wb -> cp { compressWindowBits = wb }) `ap` - shrink (compressWindowBits cp), - return (\ml -> cp { compressMemoryLevel = ml }) `ap` - shrink (compressMemoryLevel cp), - return (\st -> cp { compressStrategy = st }) `ap` - shrink (compressStrategy cp), - return (\bs -> cp { compressBufferSize = bs }) `ap` - shrink (compressBufferSize cp) - ] - arbitraryBufferSize :: Gen Int arbitraryBufferSize = frequency $ [(10, return n) | n <- [1..1024]] ++ [(20, return n) | n <- [1025..8192]] ++ @@ -48,10 +30,7 @@ deriving instance Show DecompressParams instance Arbitrary DecompressParams where - arbitrary = return DecompressParams `ap` arbitrary `ap` arbitraryBufferSize `ap` return Nothing - shrink dp = msum [ - return (\wb -> dp { decompressWindowBits = wb }) `ap` - shrink (decompressWindowBits dp), - return (\bs -> dp { decompressBufferSize = bs }) `ap` - shrink (decompressBufferSize dp) - ] + arbitrary = return DecompressParams `ap` arbitrary + `ap` arbitraryBufferSize + `ap` return Nothing + diff --git a/test/Test/Codec/Compression/Zlib/Stream.hs b/test/Test/Codec/Compression/Zlib/Stream.hs --- a/test/Test/Codec/Compression/Zlib/Stream.hs +++ b/test/Test/Codec/Compression/Zlib/Stream.hs @@ -9,41 +9,32 @@ import Test.QuickCheck -deriving instance Show Format instance Arbitrary Format where -- GZipOrZlib omitted since it's not symmetric arbitrary = elements [gzipFormat, zlibFormat, rawFormat] -deriving instance Show Method instance Arbitrary Method where arbitrary = return deflateMethod -deriving instance Show CompressionLevel instance Arbitrary CompressionLevel where arbitrary = elements $ [defaultCompression, noCompression, bestCompression, bestSpeed] ++ map compressionLevel [1..9] -deriving instance Eq WindowBits deriving instance Ord WindowBits -deriving instance Show WindowBits instance Arbitrary WindowBits where arbitrary = elements $ defaultWindowBits:map windowBits [8..15] - shrink DefaultWindowBits = [] - shrink (WindowBits n) = defaultWindowBits:map windowBits [n+1..15] -deriving instance Show MemoryLevel instance Arbitrary MemoryLevel where arbitrary = elements $ [defaultMemoryLevel, minMemoryLevel, maxMemoryLevel] ++ [memoryLevel n | n <- [1..9]] -deriving instance Show CompressionStrategy instance Arbitrary CompressionStrategy where arbitrary = elements $ [defaultStrategy, filteredStrategy, huffmanOnlyStrategy] -- These are disabled by default in the package diff --git a/test/Utils.hs b/test/Utils.hs --- a/test/Utils.hs +++ b/test/Utils.hs @@ -10,7 +10,7 @@ -- QuickCheck Utils maxStrSize :: Double -maxStrSize = 5000 +maxStrSize = 500 -- convert a QC size parameter into one for generating long lists, -- growing inverse exponentially up to maxStrSize diff --git a/test/data/bad-crc.gz b/test/data/bad-crc.gz new file mode 100644 Binary files /dev/null and b/test/data/bad-crc.gz differ diff --git a/test/data/custom-dict.zlib b/test/data/custom-dict.zlib new file mode 100644 Binary files /dev/null and b/test/data/custom-dict.zlib differ diff --git a/test/data/custom-dict.zlib-dict b/test/data/custom-dict.zlib-dict new file mode 100644 --- /dev/null +++ b/test/data/custom-dict.zlib-dict @@ -0,0 +1,1 @@ +Haskell diff --git a/test/data/hello.gz b/test/data/hello.gz new file mode 100644 Binary files /dev/null and b/test/data/hello.gz differ diff --git a/test/data/not-gzip b/test/data/not-gzip new file mode 100644 --- /dev/null +++ b/test/data/not-gzip @@ -0,0 +1,1 @@ +This is not a gzip file! diff --git a/test/data/two-files.gz b/test/data/two-files.gz new file mode 100644 Binary files /dev/null and b/test/data/two-files.gz differ diff --git a/zlib.cabal b/zlib.cabal --- a/zlib.cabal +++ b/zlib.cabal @@ -1,6 +1,6 @@ name: zlib -version: 0.6.0.0 -copyright: (c) 2006-2014 Duncan Coutts +version: 0.6.0.1 +copyright: (c) 2006-2015 Duncan Coutts license: BSD3 license-file: LICENSE author: Duncan Coutts @@ -18,9 +18,15 @@ provides access to the full zlib feature set. build-type: Simple cabal-version: >= 1.10 -extra-source-files: cbits/crc32.h cbits/inffast.h cbits/inflate.h +extra-source-files: changelog + -- zlib C sources (for Windows) + cbits/crc32.h cbits/inffast.h cbits/inflate.h cbits/trees.h cbits/deflate.h cbits/inffixed.h - cbits/inftrees.h cbits/zutil.h + cbits/inftrees.h cbits/zutil.h cbits/gzguts.h + -- test data files + test/data/bad-crc.gz test/data/custom-dict.zlib + test/data/custom-dict.zlib-dict test/data/hello.gz + test/data/not-gzip test/data/two-files.gz -- demo programs: examples/gzip.hs examples/gunzip.hs @@ -39,9 +45,13 @@ else default-language: Haskell2010 other-extensions: CPP, ForeignFunctionInterface, RankNTypes, BangPatterns, - DeriveDataTypeable, DeriveGeneric - build-depends: base >= 3 && < 5, + DeriveDataTypeable + if impl(ghc >= 7.2) + other-extensions: DeriveGeneric + build-depends: base >= 4 && < 5, bytestring >= 0.9 && < 0.12 + if impl(ghc >= 7.2 && < 7.6) + build-depends: ghc-prim includes: zlib.h ghc-options: -Wall -fwarn-tabs if !os(windows) @@ -68,7 +78,7 @@ build-depends: base, bytestring, zlib, QuickCheck == 2.*, HUnit == 1.2.*, - tasty == 0.8.*, + tasty >= 0.8 && < 0.11, tasty-quickcheck == 0.8.*, tasty-hunit == 0.8.* ghc-options: -Wall