------------------------------------------------------------------  ZLib for Ada thick binding.                               ----                                                            ----  Copyright (C) 2002-2003 Dmitriy Anisimkov                 ----                                                            ----  Open source license information is in the zlib.ads file.  --------------------------------------------------------------------  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.4 2004/07/23 07:49:54 vagul Exp $with ZLib;with Ada.Streams;with Ada.Numerics.Discrete_Random;with Ada.Text_IO;with Ada.Exceptions;with Ada.Task_Identification;procedure MTest is   use Ada.Streams;   use ZLib;   Stop : Boolean := False;   pragma Atomic (Stop);   subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;   package Random_Elements is      new Ada.Numerics.Discrete_Random (Visible_Symbols);   task type Test_Task;   task body Test_Task is      Buffer : Stream_Element_Array (1 .. 100_000);      Gen : Random_Elements.Generator;      Buffer_First  : Stream_Element_Offset;      Compare_First : Stream_Element_Offset;      Deflate : Filter_Type;      Inflate : Filter_Type;      procedure Further (Item : in Stream_Element_Array);      procedure Read_Buffer        (Item : out Ada.Streams.Stream_Element_Array;         Last : out Ada.Streams.Stream_Element_Offset);      -------------      -- Further --      -------------      procedure Further (Item : in Stream_Element_Array) is         procedure Compare (Item : in Stream_Element_Array);         -------------         -- Compare --         -------------         procedure Compare (Item : in Stream_Element_Array) is            Next_First : Stream_Element_Offset := Compare_First + Item'Length;         begin            if Buffer (Compare_First .. Next_First - 1) /= Item then               raise Program_Error;            end if;            Compare_First := Next_First;         end Compare;         procedure Compare_Write is new ZLib.Write (Write => Compare);      begin         Compare_Write (Inflate, Item, No_Flush);      end Further;      -----------------      -- Read_Buffer --      -----------------      procedure Read_Buffer        (Item : out Ada.Streams.Stream_Element_Array;         Last : out Ada.Streams.Stream_Element_Offset)      is         Buff_Diff   : Stream_Element_Offset := Buffer'Last - Buffer_First;         Next_First : Stream_Element_Offset;      begin         if Item'Length <= Buff_Diff then            Last := Item'Last;            Next_First := Buffer_First + Item'Length;            Item := Buffer (Buffer_First .. Next_First - 1);            Buffer_First := Next_First;         else            Last := Item'First + Buff_Diff;            Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);            Buffer_First := Buffer'Last + 1;         end if;      end Read_Buffer;      procedure Translate is new Generic_Translate                                   (Data_In  => Read_Buffer,                                    Data_Out => Further);   begin      Random_Elements.Reset (Gen);      Buffer := (others => 20);      Main : loop         for J in Buffer'Range loop            Buffer (J) := Random_Elements.Random (Gen);            Deflate_Init (Deflate);            Inflate_Init (Inflate);            Buffer_First  := Buffer'First;            Compare_First := Buffer'First;            Translate (Deflate);            if Compare_First /= Buffer'Last + 1 then               raise Program_Error;            end if;            Ada.Text_IO.Put_Line              (Ada.Task_Identification.Image                 (Ada.Task_Identification.Current_Task)               & Stream_Element_Offset'Image (J)               & ZLib.Count'Image (Total_Out (Deflate)));            Close (Deflate);            Close (Inflate);            exit Main when Stop;         end loop;      end loop Main;   exception      when E : others =>         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));         Stop := True;   end Test_Task;   Test : array (1 .. 4) of Test_Task;   pragma Unreferenced (Test);   Dummy : Character;begin   Ada.Text_IO.Get_Immediate (Dummy);   Stop := True;end MTest;