diff options
Diffstat (limited to 'zlib/contrib/ada')
| -rw-r--r-- | zlib/contrib/ada/mtest.adb | 11 | ||||
| -rw-r--r-- | zlib/contrib/ada/read.adb | 9 | ||||
| -rw-r--r-- | zlib/contrib/ada/readme.txt | 35 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib-streams.adb | 12 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib-streams.ads | 4 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib-thin.adb | 70 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib-thin.ads | 57 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib.adb | 143 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib.ads | 105 | ||||
| -rw-r--r-- | zlib/contrib/ada/zlib.gpr | 5 |
10 files changed, 224 insertions, 227 deletions
diff --git a/zlib/contrib/ada/mtest.adb b/zlib/contrib/ada/mtest.adb index 91a96cd1e9c..c4dfd080f0c 100644 --- a/zlib/contrib/ada/mtest.adb +++ b/zlib/contrib/ada/mtest.adb @@ -5,10 +5,10 @@ -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- Continuous test for ZLib multithreading. If the test is fail --- Wou should provide thread safe allocation routines for the Z_Stream. +-- Continuous test for ZLib multithreading. If the test would fail +-- we should provide thread safe allocation routines for the Z_Stream. -- --- $Id: mtest.adb,v 1.2 2003/08/12 12:11:05 vagul Exp $ +-- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $ with ZLib; with Ada.Streams; @@ -148,6 +148,9 @@ procedure MTest is pragma Unreferenced (Test); + Dummy : Character; + begin - null; + Ada.Text_IO.Get_Immediate (Dummy); + Stop := True; end MTest; diff --git a/zlib/contrib/ada/read.adb b/zlib/contrib/ada/read.adb index 184ea00c318..1f2efbfeb80 100644 --- a/zlib/contrib/ada/read.adb +++ b/zlib/contrib/ada/read.adb @@ -6,7 +6,7 @@ -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: read.adb,v 1.7 2003/08/12 12:12:35 vagul Exp $ +-- $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $ -- Test/demo program for the generic read interface. @@ -68,7 +68,11 @@ procedure Read is -- ZLib.Read -- reading data from the File_In. - procedure Read is new ZLib.Read (Read, Read_Buffer, Read_First, Read_Last); + procedure Read is new ZLib.Read + (Read, + Read_Buffer, + Rest_First => Read_First, + Rest_Last => Read_Last); ---------- -- Read -- @@ -103,6 +107,7 @@ procedure Read is Pack_Size := 0; Offset := 1; Read_First := Read_Buffer'Last + 1; + Read_Last := Read_Buffer'Last; end Reset; begin diff --git a/zlib/contrib/ada/readme.txt b/zlib/contrib/ada/readme.txt index ad02c225ad0..ce4d2cadf0d 100644 --- a/zlib/contrib/ada/readme.txt +++ b/zlib/contrib/ada/readme.txt @@ -1,23 +1,34 @@ - - ZLib for Ada thick binding (ZLib.Ada) - Release 1.2 + ZLib for Ada thick binding (ZLib.Ada) + Release 1.3 ZLib.Ada is a thick binding interface to the popular ZLib data compression library, available at http://www.gzip.org/zlib/. It provides Ada-style access to the ZLib C library. - Here are the main changes since ZLib.Ada 1.1: + Here are the main changes since ZLib.Ada 1.2: + +- Attension: ZLib.Read generic routine have a initialization requirement + for Read_Last parameter now. It is a bit incompartible with previous version, + but extends functionality, we could use new parameters Allow_Read_Some and + Flush now. + +- Added Is_Open routines to ZLib and ZLib.Streams packages. -- The default header type has a name "Default" now. Auto is used only for - automatic GZip/ZLib header detection. +- Add pragma Assert to check Stream_Element is 8 bit. -- Added test for multitasking mtest.adb. +- Fix extraction to buffer with exact known decompressed size. Error reported by + Steve Sangwine. -- Added GNAT project file zlib.gpr. +- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits + computers. Patch provided by Pascal Obry. +- Add Status_Error exception definition. - How to build ZLib.Ada under GNAT +- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit. + + + How to build ZLib.Ada under GNAT You should have the ZLib library already build on your computer, before building ZLib.Ada. Make the directory of ZLib.Ada sources current and @@ -30,7 +41,7 @@ Or use the GNAT project file build for GNAT 3.15 or later: gnatmake -Pzlib.gpr -L<directory where libz.a is> - How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2 + How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2 1. Make a project with all *.ads and *.adb files from the distribution. 2. Build the libz.a library from the ZLib C sources. @@ -40,7 +51,7 @@ Or use the GNAT project file build for GNAT 3.15 or later: 6. Build the executable using test.adb as a main procedure. - How to use ZLib.Ada + How to use ZLib.Ada The source files test.adb and read.adb are small demo programs that show the main functionality of ZLib.Ada. @@ -50,3 +61,5 @@ The routines from the package specifications are commented. Homepage: http://zlib-ada.sourceforge.net/ Author: Dmitriy Anisimkov <anisimkov@yahoo.com> + +Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk> diff --git a/zlib/contrib/ada/zlib-streams.adb b/zlib/contrib/ada/zlib-streams.adb index d213b5c1766..b6497bae286 100644 --- a/zlib/contrib/ada/zlib-streams.adb +++ b/zlib/contrib/ada/zlib-streams.adb @@ -6,7 +6,7 @@ -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: zlib-streams.adb,v 1.9 2003/08/12 13:15:31 vagul Exp $ +-- $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $ with Ada.Unchecked_Deallocation; @@ -90,6 +90,7 @@ package body ZLib.Streams is Stream.Buffer := new Buffer_Subtype; Stream.Rest_First := Stream.Buffer'Last + 1; + Stream.Rest_Last := Stream.Buffer'Last; end if; end Create; @@ -113,6 +114,15 @@ package body ZLib.Streams is end loop; end Flush; + ------------- + -- Is_Open -- + ------------- + + function Is_Open (Stream : Stream_Type) return Boolean is + begin + return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer); + end Is_Open; + ---------- -- Read -- ---------- diff --git a/zlib/contrib/ada/zlib-streams.ads b/zlib/contrib/ada/zlib-streams.ads index 1d5e9048991..f0193c6baee 100644 --- a/zlib/contrib/ada/zlib-streams.ads +++ b/zlib/contrib/ada/zlib-streams.ads @@ -6,7 +6,7 @@ -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: zlib-streams.ads,v 1.11 2003/08/12 13:15:31 vagul Exp $ +-- $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $ package ZLib.Streams is @@ -77,6 +77,8 @@ package ZLib.Streams is -- !!! When the Need_Header is False ZLib-Ada is using undocumented -- ZLib 1.1.4 functionality to do not create/wait for ZLib headers. + function Is_Open (Stream : Stream_Type) return Boolean; + procedure Close (Stream : in out Stream_Type); private diff --git a/zlib/contrib/ada/zlib-thin.adb b/zlib/contrib/ada/zlib-thin.adb index 163bd5b972f..0ca4a712046 100644 --- a/zlib/contrib/ada/zlib-thin.adb +++ b/zlib/contrib/ada/zlib-thin.adb @@ -6,12 +6,11 @@ -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: zlib-thin.adb,v 1.6 2003/01/21 15:26:37 vagul Exp $ +-- $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $ package body ZLib.Thin is - ZLIB_VERSION : constant Chars_Ptr := - Interfaces.C.Strings.New_String ("1.1.4"); + ZLIB_VERSION : constant Chars_Ptr := zlibVersion; Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit; @@ -38,14 +37,6 @@ package body ZLib.Thin is ------------------ function Deflate_Init - (strm : in Z_Streamp; - level : in Int := Z_DEFAULT_COMPRESSION) - return Int is - begin - return deflateInit (strm, level, ZLIB_VERSION, Z_Stream_Size); - end Deflate_Init; - - function Deflate_Init (strm : Z_Streamp; level : Int; method : Int; @@ -69,16 +60,15 @@ package body ZLib.Thin is -- Inflate_Init -- ------------------ - function Inflate_Init (strm : Z_Streamp) return Int is - begin - return inflateInit (strm, ZLIB_VERSION, Z_Stream_Size); - end Inflate_Init; - function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is begin return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size); end Inflate_Init; + ------------------------ + -- Last_Error_Message -- + ------------------------ + function Last_Error_Message (Strm : in Z_Stream) return String is use Interfaces.C.Strings; begin @@ -89,54 +79,28 @@ package body ZLib.Thin is end if; end Last_Error_Message; - ------------- - -- Need_In -- - ------------- - - function Need_In (strm : Z_Stream) return Boolean is - begin - return strm.Avail_In = 0; - end Need_In; - - -------------- - -- Need_Out -- - -------------- - - function Need_Out (strm : Z_Stream) return Boolean is - begin - return strm.Avail_Out = 0; - end Need_Out; - ------------ -- Set_In -- ------------ procedure Set_In (Strm : in out Z_Stream; - Buffer : in Byte_Access; - Size : in UInt) is + Buffer : in Voidp; + Size : in UInt) is begin Strm.Next_In := Buffer; Strm.Avail_In := Size; end Set_In; - procedure Set_In - (Strm : in out Z_Stream; - Buffer : in Voidp; - Size : in UInt) is - begin - Set_In (Strm, Bytes.To_Pointer (Buffer), Size); - end Set_In; - ------------------ -- Set_Mem_Func -- ------------------ procedure Set_Mem_Func (Strm : in out Z_Stream; - Opaque : in Voidp; - Alloc : in alloc_func; - Free : in free_func) is + Opaque : in Voidp; + Alloc : in alloc_func; + Free : in free_func) is begin Strm.opaque := Opaque; Strm.zalloc := Alloc; @@ -149,21 +113,13 @@ package body ZLib.Thin is procedure Set_Out (Strm : in out Z_Stream; - Buffer : in Byte_Access; - Size : in UInt) is + Buffer : in Voidp; + Size : in UInt) is begin Strm.Next_Out := Buffer; Strm.Avail_Out := Size; end Set_Out; - procedure Set_Out - (Strm : in out Z_Stream; - Buffer : in Voidp; - Size : in UInt) is - begin - Set_Out (Strm, Bytes.To_Pointer (Buffer), Size); - end Set_Out; - -------------- -- Total_In -- -------------- diff --git a/zlib/contrib/ada/zlib-thin.ads b/zlib/contrib/ada/zlib-thin.ads index c227374f64b..d4407eb800d 100644 --- a/zlib/contrib/ada/zlib-thin.ads +++ b/zlib/contrib/ada/zlib-thin.ads @@ -6,10 +6,11 @@ -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: zlib-thin.ads,v 1.8 2003/08/12 13:16:51 vagul Exp $ +-- $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $ with Interfaces.C.Strings; -with System.Address_To_Access_Conversions; + +with System; private package ZLib.Thin is @@ -36,18 +37,18 @@ private package ZLib.Thin is -- zconf.h:216 type Int is new Interfaces.C.int; - type ULong is new Interfaces.C.unsigned; -- 32 bits or more - -- zconf.h:217 + type ULong is new Interfaces.C.unsigned_long; -- 32 bits or more + -- zconf.h:217 subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr; type ULong_Access is access ULong; type Int_Access is access Int; - subtype Voidp is System.Address; -- zconf.h:232 - package Bytes is new System.Address_To_Access_Conversions (Byte); + subtype Voidp is System.Address; -- zconf.h:232 - subtype Byte_Access is Bytes.Object_Pointer; + subtype Byte_Access is Voidp; + Nul : constant Voidp := System.Null_Address; -- end from zconf Z_NO_FLUSH : constant := 8#0000#; -- zlib.h:125 @@ -251,12 +252,6 @@ private package ZLib.Thin is stream_size : Int) return Int; - function Deflate_Init - (strm : in Z_Streamp; - level : in Int := Z_DEFAULT_COMPRESSION) - return Int; - pragma Inline (Deflate_Init); - function deflateInit2 (strm : Z_Streamp; level : Int; @@ -284,9 +279,6 @@ private package ZLib.Thin is stream_size : Int) return Int; - function Inflate_Init (strm : Z_Streamp) return Int; - pragma Inline (Inflate_Init); - function inflateInit2 (strm : in Z_Streamp; windowBits : in Int; @@ -318,20 +310,6 @@ private package ZLib.Thin is -- has dropped to zero. The application must initialize zalloc, zfree and -- opaque before calling the init function. - function Need_In (strm : in Z_Stream) return Boolean; - -- return true when we do not need to setup Next_In and Avail_In fields. - pragma Inline (Need_In); - - function Need_Out (strm : in Z_Stream) return Boolean; - -- return true when we do not need to setup Next_Out and Avail_Out field. - pragma Inline (Need_Out); - - procedure Set_In - (Strm : in out Z_Stream; - Buffer : in Byte_Access; - Size : in UInt); - pragma Inline (Set_In); - procedure Set_In (Strm : in out Z_Stream; Buffer : in Voidp; @@ -340,12 +318,6 @@ private package ZLib.Thin is procedure Set_Out (Strm : in out Z_Stream; - Buffer : in Byte_Access; - Size : in UInt); - pragma Inline (Set_Out); - - procedure Set_Out - (Strm : in out Z_Stream; Buffer : in Voidp; Size : in UInt); pragma Inline (Set_Out); @@ -388,19 +360,13 @@ private package ZLib.Thin is function zlibCompileFlags return ULong; - function deflatePrime - (strm : Z_Streamp; - bits : Int; - value : Int) - return Int; - private type Z_Stream is record -- zlib.h:68 - Next_In : Byte_Access; -- next input byte + Next_In : Voidp := Nul; -- next input byte Avail_In : UInt := 0; -- number of bytes available at next_in Total_In : ULong := 0; -- total nb of input bytes read so far - Next_Out : Byte_Access; -- next output byte should be put there + Next_Out : Voidp := Nul; -- next output byte should be put there Avail_Out : UInt := 0; -- remaining free space at next_out Total_Out : ULong := 0; -- total nb of bytes output so far msg : Chars_Ptr; -- last error message, NULL if no error @@ -460,14 +426,13 @@ private pragma Import (C, inflateSyncPoint, "inflateSyncPoint"); pragma Import (C, get_crc_table, "get_crc_table"); - -- added in zlib 1.2.1: + -- since zlib 1.2.0: pragma Import (C, inflateCopy, "inflateCopy"); pragma Import (C, compressBound, "compressBound"); pragma Import (C, deflateBound, "deflateBound"); pragma Import (C, gzungetc, "gzungetc"); pragma Import (C, zlibCompileFlags, "zlibCompileFlags"); - pragma Import (C, deflatePrime, "deflatePrime"); pragma Import (C, inflateBackInit, "inflateBackInit_"); diff --git a/zlib/contrib/ada/zlib.adb b/zlib/contrib/ada/zlib.adb index 93bf8852f72..8b6fd686ac7 100644 --- a/zlib/contrib/ada/zlib.adb +++ b/zlib/contrib/ada/zlib.adb @@ -1,12 +1,12 @@ ---------------------------------------------------------------- -- ZLib for Ada thick binding. -- -- -- --- Copyright (C) 2002-2003 Dmitriy Anisimkov -- +-- Copyright (C) 2002-2004 Dmitriy Anisimkov -- -- -- -- Open source license information is in the zlib.ads file. -- ---------------------------------------------------------------- --- $Id: zlib.adb,v 1.19 2003/07/13 16:02:19 vagul Exp $ +-- $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $ with Ada.Exceptions; with Ada.Unchecked_Conversion; @@ -34,7 +34,7 @@ package body ZLib is VERSION_ERROR); type Flate_Step_Function is access - function (Strm : Thin.Z_Streamp; flush : Thin.Int) return Thin.Int; + function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int; pragma Convention (C, Flate_Step_Function); type Flate_End_Function is access @@ -82,13 +82,13 @@ package body ZLib is Flush_Finish : constant array (Boolean) of Flush_Mode := (True => Finish, False => No_Flush); - procedure Raise_Error (Stream : Z_Stream); + procedure Raise_Error (Stream : in Z_Stream); pragma Inline (Raise_Error); - procedure Raise_Error (Message : String); + procedure Raise_Error (Message : in String); pragma Inline (Raise_Error); - procedure Check_Error (Stream : Z_Stream; Code : Thin.Int); + procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int); procedure Free is new Ada.Unchecked_Deallocation (Z_Stream, Z_Stream_Access); @@ -118,7 +118,7 @@ package body ZLib is -- Check_Error -- ----------------- - procedure Check_Error (Stream : Z_Stream; Code : Thin.Int) is + procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is use type Thin.Int; begin if Code /= Thin.Z_OK then @@ -138,10 +138,11 @@ package body ZLib is is Code : Thin.Int; begin - Code := Flate (Filter.Compression).Done - (To_Thin_Access (Filter.Strm)); + if not Ignore_Error and then not Is_Open (Filter) then + raise Status_Error; + end if; - Filter.Opened := False; + Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm)); if Ignore_Error or else Code = Thin.Z_OK then Free (Filter.Strm); @@ -154,7 +155,7 @@ package body ZLib is Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Return_Code_Enum'Image (Return_Code (Code)) - & ": " & Error_Message); + & ": " & Error_Message); end; end if; end Close; @@ -170,10 +171,9 @@ package body ZLib is is use Thin; begin - return Unsigned_32 (crc32 - (ULong (CRC), - Bytes.To_Pointer (Data'Address), - Data'Length)); + return Unsigned_32 (crc32 (ULong (CRC), + Data'Address, + Data'Length)); end CRC32; procedure CRC32 @@ -192,13 +192,17 @@ package body ZLib is Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Method : in Compression_Method := Deflated; - Window_Bits : in Window_Bits_Type := 15; - Memory_Level : in Memory_Level_Type := 8; + Window_Bits : in Window_Bits_Type := Default_Window_Bits; + Memory_Level : in Memory_Level_Type := Default_Memory_Level; Header : in Header_Type := Default) is use type Thin.Int; Win_Bits : Thin.Int := Thin.Int (Window_Bits); begin + if Is_Open (Filter) then + raise Status_Error; + end if; + -- We allow ZLib to make header only in case of default header type. -- Otherwise we would either do header by ourselfs, or do not do -- header at all. @@ -216,10 +220,9 @@ package body ZLib is Filter.Offset := Simple_GZip_Header'Last + 1; end if; - Filter.Strm := new Z_Stream; + Filter.Strm := new Z_Stream; Filter.Compression := True; Filter.Stream_End := False; - Filter.Opened := True; Filter.Header := Header; if Thin.Deflate_Init @@ -255,18 +258,18 @@ package body ZLib is ----------------------- procedure Generic_Translate - (Filter : in out ZLib.Filter_Type; - In_Buffer_Size : Integer := Default_Buffer_Size; - Out_Buffer_Size : Integer := Default_Buffer_Size) + (Filter : in out ZLib.Filter_Type; + In_Buffer_Size : in Integer := Default_Buffer_Size; + Out_Buffer_Size : in Integer := Default_Buffer_Size) is - In_Buffer : Stream_Element_Array - (1 .. Stream_Element_Offset (In_Buffer_Size)); + In_Buffer : Stream_Element_Array + (1 .. Stream_Element_Offset (In_Buffer_Size)); Out_Buffer : Stream_Element_Array - (1 .. Stream_Element_Offset (Out_Buffer_Size)); - Last : Stream_Element_Offset; - In_Last : Stream_Element_Offset; - In_First : Stream_Element_Offset; - Out_Last : Stream_Element_Offset; + (1 .. Stream_Element_Offset (Out_Buffer_Size)); + Last : Stream_Element_Offset; + In_Last : Stream_Element_Offset; + In_First : Stream_Element_Offset; + Out_Last : Stream_Element_Offset; begin Main : loop Data_In (In_Buffer, Last); @@ -275,18 +278,21 @@ package body ZLib is loop Translate - (Filter, - In_Buffer (In_First .. Last), - In_Last, - Out_Buffer, - Out_Last, - Flush_Finish (Last < In_Buffer'First)); + (Filter => Filter, + In_Data => In_Buffer (In_First .. Last), + In_Last => In_Last, + Out_Data => Out_Buffer, + Out_Last => Out_Last, + Flush => Flush_Finish (Last < In_Buffer'First)); - Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last)); + if Out_Buffer'First <= Out_Last then + Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last)); + end if; exit Main when Stream_End (Filter); -- The end of in buffer. + exit when In_Last = Last; In_First := In_Last + 1; @@ -301,7 +307,7 @@ package body ZLib is procedure Inflate_Init (Filter : in out Filter_Type; - Window_Bits : in Window_Bits_Type := 15; + Window_Bits : in Window_Bits_Type := Default_Window_Bits; Header : in Header_Type := Default) is use type Thin.Int; @@ -320,6 +326,10 @@ package body ZLib is end Check_Version; begin + if Is_Open (Filter) then + raise Status_Error; + end if; + case Header is when None => Check_Version; @@ -344,10 +354,9 @@ package body ZLib is when Default => null; end case; - Filter.Strm := new Z_Stream; + Filter.Strm := new Z_Stream; Filter.Compression := False; Filter.Stream_End := False; - Filter.Opened := True; Filter.Header := Header; if Thin.Inflate_Init @@ -357,16 +366,25 @@ package body ZLib is end if; end Inflate_Init; + ------------- + -- Is_Open -- + ------------- + + function Is_Open (Filter : in Filter_Type) return Boolean is + begin + return Filter.Strm /= null; + end Is_Open; + ----------------- -- Raise_Error -- ----------------- - procedure Raise_Error (Message : String) is + procedure Raise_Error (Message : in String) is begin Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message); end Raise_Error; - procedure Raise_Error (Stream : Z_Stream) is + procedure Raise_Error (Stream : in Z_Stream) is begin Raise_Error (Last_Error_Message (Stream)); end Raise_Error; @@ -378,21 +396,29 @@ package body ZLib is procedure Read (Filter : in out Filter_Type; Item : out Ada.Streams.Stream_Element_Array; - Last : out Ada.Streams.Stream_Element_Offset) + Last : out Ada.Streams.Stream_Element_Offset; + Flush : in Flush_Mode := No_Flush) is In_Last : Stream_Element_Offset; Item_First : Ada.Streams.Stream_Element_Offset := Item'First; + V_Flush : Flush_Mode := Flush; begin pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1); + pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last); loop - if Rest_First > Buffer'Last then + if Rest_Last = Buffer'First - 1 then + V_Flush := Finish; + + elsif Rest_First > Rest_Last then Read (Buffer, Rest_Last); Rest_First := Buffer'First; - end if; - pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last); + if Rest_Last < Buffer'First then + V_Flush := Finish; + end if; + end if; Translate (Filter => Filter, @@ -400,11 +426,13 @@ package body ZLib is In_Last => In_Last, Out_Data => Item (Item_First .. Item'Last), Out_Last => Last, - Flush => Flush_Finish (Rest_Last < Rest_First)); + Flush => V_Flush); Rest_First := In_Last + 1; - exit when Last = Item'Last or else Stream_End (Filter); + exit when Stream_End (Filter) + or else Last = Item'Last + or else (Last >= Item'First and then Allow_Read_Some); Item_First := Last + 1; end loop; @@ -489,11 +517,11 @@ package body ZLib is Code : Thin.Int; begin - if Filter.Opened = False then - raise ZLib_Error; + if not Is_Open (Filter) then + raise Status_Error; end if; - if Out_Data'Length = 0 then + if Out_Data'Length = 0 and then In_Data'Length = 0 then raise Constraint_Error; end if; @@ -514,7 +542,6 @@ package body ZLib is - Stream_Element_Offset (Avail_In (Filter.Strm.all)); Out_Last := Out_Data'Last - Stream_Element_Offset (Avail_Out (Filter.Strm.all)); - end Translate_Auto; -------------------- @@ -529,7 +556,7 @@ package body ZLib is Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode) is - Out_First : Stream_Element_Offset; + Out_First : Stream_Element_Offset; procedure Add_Data (Data : in Stream_Element_Array); -- Add data to stream from the Filter.Offset till necessary, @@ -596,7 +623,7 @@ package body ZLib is Add_Data (Simple_GZip_Header); Translate_Auto - (Filter => Filter, + (Filter => Filter, In_Data => In_Data, In_Last => In_Last, Out_Data => Out_Data (Out_First .. Out_Data'Last), @@ -604,7 +631,6 @@ package body ZLib is Flush => Flush); CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last)); - end if; if Filter.Stream_End and then Out_Last <= Out_Data'Last then @@ -642,10 +668,11 @@ package body ZLib is procedure Write (Filter : in out Filter_Type; Item : in Ada.Streams.Stream_Element_Array; - Flush : in Flush_Mode) + Flush : in Flush_Mode := No_Flush) is - Buffer : Stream_Element_Array (1 .. Buffer_Size); - In_Last, Out_Last : Stream_Element_Offset; + Buffer : Stream_Element_Array (1 .. Buffer_Size); + In_Last : Stream_Element_Offset; + Out_Last : Stream_Element_Offset; In_First : Stream_Element_Offset := Item'First; begin if Item'Length = 0 and Flush = No_Flush then @@ -654,7 +681,7 @@ package body ZLib is loop Translate - (Filter => Filter, + (Filter => Filter, In_Data => Item (In_First .. Item'Last), In_Last => In_Last, Out_Data => Buffer, diff --git a/zlib/contrib/ada/zlib.ads b/zlib/contrib/ada/zlib.ads index b72e4d2d5d7..79ffc4095cf 100644 --- a/zlib/contrib/ada/zlib.ads +++ b/zlib/contrib/ada/zlib.ads @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- ZLib for Ada thick binding. -- -- -- --- Copyright (C) 2002-2003 Dmitriy Anisimkov -- +-- Copyright (C) 2002-2004 Dmitriy Anisimkov -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under the terms of the GNU General Public License as published by -- @@ -25,7 +25,7 @@ -- covered by the GNU Public License. -- ------------------------------------------------------------------------------ --- $Id: zlib.ads,v 1.17 2003/08/12 13:19:07 vagul Exp $ +-- $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $ with Ada.Streams; @@ -33,7 +33,8 @@ with Interfaces; package ZLib is - ZLib_Error : exception; + ZLib_Error : exception; + Status_Error : exception; type Compression_Level is new Integer range -1 .. 9; @@ -55,12 +56,15 @@ package ZLib is subtype Count is Ada.Streams.Stream_Element_Count; + Default_Memory_Level : constant Memory_Level_Type := 8; + Default_Window_Bits : constant Window_Bits_Type := 15; + ---------------------------------- -- Compression method constants -- ---------------------------------- Deflated : constant Compression_Method; - -- Only one method allowed in this ZLib version. + -- Only one method allowed in this ZLib version --------------------------------- -- Compression level constants -- @@ -79,21 +83,29 @@ package ZLib is -- Regular way for compression, no flush Partial_Flush : constant Flush_Mode; - -- will be removed, use Z_SYNC_FLUSH instead + -- Will be removed, use Z_SYNC_FLUSH instead Sync_Flush : constant Flush_Mode; - -- all pending output is flushed to the output buffer and the output + -- All pending output is flushed to the output buffer and the output -- is aligned on a byte boundary, so that the decompressor can get all -- input data available so far. (In particular avail_in is zero after the -- call if enough output space has been provided before the call.) -- Flushing may degrade compression for some compression algorithms and so -- it should be used only when necessary. + Block_Flush : constant Flush_Mode; + -- Z_BLOCK requests that inflate() stop + -- if and when it get to the next deflate block boundary. When decoding the + -- zlib or gzip format, this will cause inflate() to return immediately + -- after the header and before the first block. When doing a raw inflate, + -- inflate() will go ahead and process the first block, and will return + -- when it gets to the end of that block, or when it runs out of data. + Full_Flush : constant Flush_Mode; - -- all output is flushed as with SYNC_FLUSH, and the compression state + -- All output is flushed as with SYNC_FLUSH, and the compression state -- is reset so that decompression can restart from this point if previous -- compressed data has been damaged or if random access is desired. Using - -- FULL_FLUSH too often can seriously degrade the compression. + -- Full_Flush too often can seriously degrade the compression. Finish : constant Flush_Mode; -- Just for tell the compressor that input data is complete. @@ -111,7 +123,7 @@ package ZLib is Default_Buffer_Size : constant := 4096; - type Filter_Type is limited private; + type Filter_Type is tagged limited private; -- The filter is for compression and for decompression. -- The usage of the type is depend of its initialization. @@ -124,8 +136,8 @@ package ZLib is Level : in Compression_Level := Default_Compression; Strategy : in Strategy_Type := Default_Strategy; Method : in Compression_Method := Deflated; - Window_Bits : in Window_Bits_Type := 15; - Memory_Level : in Memory_Level_Type := 8; + Window_Bits : in Window_Bits_Type := Default_Window_Bits; + Memory_Level : in Memory_Level_Type := Default_Memory_Level; Header : in Header_Type := Default); -- Compressor initialization. -- When Header parameter is Auto or Default, then default zlib header @@ -136,7 +148,7 @@ package ZLib is procedure Inflate_Init (Filter : in out Filter_Type; - Window_Bits : in Window_Bits_Type := 15; + Window_Bits : in Window_Bits_Type := Default_Window_Bits; Header : in Header_Type := Default); -- Decompressor initialization. -- Default header type mean that ZLib default header is expecting in the @@ -146,10 +158,14 @@ package ZLib is -- input compressed stream. -- Auto header type mean that header type (GZip or Native) would be -- detected automatically in the input stream. - -- Note that header types parameter values None, GZip and Auto is - -- supporting for inflate routine only in ZLib versions 1.2.0.2 and later. + -- Note that header types parameter values None, GZip and Auto are + -- supported for inflate routine only in ZLib versions 1.2.0.2 and later. -- Deflate_Init is supporting all header types. + function Is_Open (Filter : in Filter_Type) return Boolean; + pragma Inline (Is_Open); + -- Is the filter opened for compression or decompression. + procedure Close (Filter : in out Filter_Type; Ignore_Error : in Boolean := False); @@ -167,31 +183,31 @@ package ZLib is (Filter : in out Filter_Type; In_Buffer_Size : in Integer := Default_Buffer_Size; Out_Buffer_Size : in Integer := Default_Buffer_Size); - -- Compressing/decompressing data arrived from Data_In routine + -- Compress/decompress data fetch from Data_In routine and pass the result -- to the Data_Out routine. User should provide Data_In and Data_Out -- for compression/decompression data flow. - -- Compression or decompression depend on initialization of Filter. + -- Compression or decompression depend on Filter initialization. function Total_In (Filter : in Filter_Type) return Count; pragma Inline (Total_In); - -- Return total number of input bytes read so far. + -- Returns total number of input bytes read so far function Total_Out (Filter : in Filter_Type) return Count; pragma Inline (Total_Out); - -- Return total number of bytes output so far. + -- Returns total number of bytes output so far function CRC32 (CRC : in Unsigned_32; Data : in Ada.Streams.Stream_Element_Array) return Unsigned_32; pragma Inline (CRC32); - -- Calculate CRC32, it could be necessary for make gzip format. + -- Compute CRC32, it could be necessary for make gzip format procedure CRC32 (CRC : in out Unsigned_32; Data : in Ada.Streams.Stream_Element_Array); pragma Inline (CRC32); - -- Calculate CRC32, it could be necessary for make gzip format. + -- Compute CRC32, it could be necessary for make gzip format ------------------------------------------------- -- Below is more complex low level routines. -- @@ -204,15 +220,11 @@ package ZLib is Out_Data : out Ada.Streams.Stream_Element_Array; Out_Last : out Ada.Streams.Stream_Element_Offset; Flush : in Flush_Mode); - -- Compressing/decompressing the datas from In_Data buffer to the - -- Out_Data buffer. - -- In_Data is incoming data portion, - -- In_Last is the index of last element from In_Data accepted by the - -- Filter. - -- Out_Data is the buffer for output data from the filter. - -- Out_Last is the last element of the received data from Filter. - -- To tell the filter that incoming data is complete put the - -- Flush parameter to FINISH. + -- Compress/decompress the In_Data buffer and place the result into + -- Out_Data. In_Last is the index of last element from In_Data accepted by + -- the Filter. Out_Last is the last element of the received data from + -- Filter. To tell the filter that incoming data are complete put the + -- Flush parameter to Finish. function Stream_End (Filter : in Filter_Type) return Boolean; pragma Inline (Stream_End); @@ -239,10 +251,9 @@ package ZLib is procedure Write (Filter : in out Filter_Type; Item : in Ada.Streams.Stream_Element_Array; - Flush : in Flush_Mode); - -- Compressing/Decompressing data from Item to the - -- generic parameter procedure Write. - -- Output buffer size could be set in Buffer_Size generic parameter. + Flush : in Flush_Mode := No_Flush); + -- Compress/Decompress data from Item to the generic parameter procedure + -- Write. Output buffer size could be set in Buffer_Size generic parameter. generic with procedure Read @@ -257,33 +268,41 @@ package ZLib is Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset; -- Rest_First have to be initialized to Buffer'Last + 1 + -- Rest_Last have to be initialized to Buffer'Last -- before usage. + Allow_Read_Some : in Boolean := False; + -- Is it allowed to return Last < Item'Last before end of data. + procedure Read (Filter : in out Filter_Type; Item : out Ada.Streams.Stream_Element_Array; - Last : out Ada.Streams.Stream_Element_Offset); - -- Compressing/Decompressing data from generic parameter - -- procedure Read to the Item. - -- User should provide Buffer for the operation - -- and Rest_First variable first time initialized to the Buffer'Last + 1. + Last : out Ada.Streams.Stream_Element_Offset; + Flush : in Flush_Mode := No_Flush); + -- Compress/Decompress data from generic parameter procedure Read to the + -- Item. User should provide Buffer and initialized Rest_First, Rest_Last + -- indicators. If Allow_Read_Some is True, Read routines could return + -- Last < Item'Last only at end of stream. private use Ada.Streams; - type Flush_Mode is new Integer range 0 .. 4; + pragma Assert (Ada.Streams.Stream_Element'Size = 8); + pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8); + + type Flush_Mode is new Integer range 0 .. 5; type Compression_Method is new Integer range 8 .. 8; type Strategy_Type is new Integer range 0 .. 3; No_Flush : constant Flush_Mode := 0; + Partial_Flush : constant Flush_Mode := 1; Sync_Flush : constant Flush_Mode := 2; Full_Flush : constant Flush_Mode := 3; Finish : constant Flush_Mode := 4; - Partial_Flush : constant Flush_Mode := 1; - -- will be removed, use Z_SYNC_FLUSH instead + Block_Flush : constant Flush_Mode := 5; Filtered : constant Strategy_Type := 1; Huffman_Only : constant Strategy_Type := 2; @@ -296,7 +315,7 @@ private type Z_Stream_Access is access all Z_Stream; - type Filter_Type is record + type Filter_Type is tagged limited record Strm : Z_Stream_Access; Compression : Boolean; Stream_End : Boolean; @@ -304,8 +323,6 @@ private CRC : Unsigned_32; Offset : Stream_Element_Offset; -- Offset for gzip header/footer output. - - Opened : Boolean := False; end record; end ZLib; diff --git a/zlib/contrib/ada/zlib.gpr b/zlib/contrib/ada/zlib.gpr index 0f58985e30b..296b22aa966 100644 --- a/zlib/contrib/ada/zlib.gpr +++ b/zlib/contrib/ada/zlib.gpr @@ -3,10 +3,10 @@ project Zlib is for Languages use ("Ada"); for Source_Dirs use ("."); for Object_Dir use "."; - for Main use ("test.adb", "mtest.adb", "read.adb"); + for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo"); package Compiler is - for Default_Switches ("ada") use ("-gnatwbcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst"); + for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst"); end Compiler; package Linker is @@ -18,4 +18,3 @@ project Zlib is end Builder; end Zlib; - |