1b33c96954667ba382fa595baf7b31290bfdd517vboxsync----------------------------------------------------------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- ZLib for Ada thick binding. --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- Copyright (C) 2002-2003 Dmitriy Anisimkov --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- Open source license information is in the zlib.ads file. --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync----------------------------------------------------------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- Continuous test for ZLib multithreading. If the test would fail

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- we should provide thread safe allocation routines for the Z_Stream.

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync--

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync-- $Id$

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith ZLib;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith Ada.Streams;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith Ada.Numerics.Discrete_Random;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith Ada.Text_IO;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith Ada.Exceptions;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncwith Ada.Task_Identification;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncprocedure MTest is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync use Ada.Streams;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync use ZLib;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Stop : Boolean := False;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync pragma Atomic (Stop);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync package Random_Elements is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync new Ada.Numerics.Discrete_Random (Visible_Symbols);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync task type Test_Task;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync task body Test_Task is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer : Stream_Element_Array (1 .. 100_000);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Gen : Random_Elements.Generator;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer_First : Stream_Element_Offset;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Compare_First : Stream_Element_Offset;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Deflate : Filter_Type;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Inflate : Filter_Type;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Further (Item : in Stream_Element_Array);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Read_Buffer

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync (Item : out Ada.Streams.Stream_Element_Array;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Last : out Ada.Streams.Stream_Element_Offset);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -- Further --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Further (Item : in Stream_Element_Array) is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Compare (Item : in Stream_Element_Array);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -- Compare --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Compare (Item : in Stream_Element_Array) is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Next_First : Stream_Element_Offset := Compare_First + Item'Length;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync begin

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync if Buffer (Compare_First .. Next_First - 1) /= Item then

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync raise Program_Error;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end if;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Compare_First := Next_First;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end Compare;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Compare_Write is new ZLib.Write (Write => Compare);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync begin

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Compare_Write (Inflate, Item, No_Flush);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end Further;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -----------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -- Read_Buffer --

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync -----------------

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Read_Buffer

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync (Item : out Ada.Streams.Stream_Element_Array;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Last : out Ada.Streams.Stream_Element_Offset)

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync is

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Next_First : Stream_Element_Offset;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync begin

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync if Item'Length <= Buff_Diff then

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Last := Item'Last;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Next_First := Buffer_First + Item'Length;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Item := Buffer (Buffer_First .. Next_First - 1);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer_First := Next_First;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync else

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Last := Item'First + Buff_Diff;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer_First := Buffer'Last + 1;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end if;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end Read_Buffer;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync procedure Translate is new Generic_Translate

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync (Data_In => Read_Buffer,

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Data_Out => Further);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync begin

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Random_Elements.Reset (Gen);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer := (others => 20);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Main : loop

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync for J in Buffer'Range loop

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer (J) := Random_Elements.Random (Gen);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Deflate_Init (Deflate);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Inflate_Init (Inflate);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Buffer_First := Buffer'First;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Compare_First := Buffer'First;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Translate (Deflate);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync if Compare_First /= Buffer'Last + 1 then

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync raise Program_Error;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end if;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Ada.Text_IO.Put_Line

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync (Ada.Task_Identification.Image

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync (Ada.Task_Identification.Current_Task)

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync & Stream_Element_Offset'Image (J)

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync & ZLib.Count'Image (Total_Out (Deflate)));

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Close (Deflate);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Close (Inflate);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync exit Main when Stop;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end loop;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end loop Main;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync exception

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync when E : others =>

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Stop := True;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync end Test_Task;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Test : array (1 .. 4) of Test_Task;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync pragma Unreferenced (Test);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Dummy : Character;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncbegin

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Ada.Text_IO.Get_Immediate (Dummy);

1b33c96954667ba382fa595baf7b31290bfdd517vboxsync Stop := True;

1b33c96954667ba382fa595baf7b31290bfdd517vboxsyncend MTest;