| 1 | ---------------------------------------------------------------- |
| 2 | -- ZLib for Ada thick binding. -- |
| 3 | -- -- |
| 4 | -- Copyright (C) 2002-2003 Dmitriy Anisimkov -- |
| 5 | -- -- |
| 6 | -- Open source license information is in the zlib.ads file. -- |
| 7 | ---------------------------------------------------------------- |
| 8 | -- Continuous test for ZLib multithreading. If the test would fail |
| 9 | -- we should provide thread safe allocation routines for the Z_Stream. |
| 10 | -- |
| 11 | -- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $ |
| 12 | |
| 13 | with ZLib; |
| 14 | with Ada.Streams; |
| 15 | with Ada.Numerics.Discrete_Random; |
| 16 | with Ada.Text_IO; |
| 17 | with Ada.Exceptions; |
| 18 | with Ada.Task_Identification; |
| 19 | |
| 20 | procedure MTest is |
| 21 | use Ada.Streams; |
| 22 | use ZLib; |
| 23 | |
| 24 | Stop : Boolean := False; |
| 25 | |
| 26 | pragma Atomic (Stop); |
| 27 | |
| 28 | subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#; |
| 29 | |
| 30 | package Random_Elements is |
| 31 | new Ada.Numerics.Discrete_Random (Visible_Symbols); |
| 32 | |
| 33 | task type Test_Task; |
| 34 | |
| 35 | task body Test_Task is |
| 36 | Buffer : Stream_Element_Array (1 .. 100_000); |
| 37 | Gen : Random_Elements.Generator; |
| 38 | |
| 39 | Buffer_First : Stream_Element_Offset; |
| 40 | Compare_First : Stream_Element_Offset; |
| 41 | |
| 42 | Deflate : Filter_Type; |
| 43 | Inflate : Filter_Type; |
| 44 | |
| 45 | procedure Further (Item : in Stream_Element_Array); |
| 46 | |
| 47 | procedure Read_Buffer |
| 48 | (Item : out Ada.Streams.Stream_Element_Array; |
| 49 | Last : out Ada.Streams.Stream_Element_Offset); |
| 50 | |
| 51 | ------------- |
| 52 | -- Further -- |
| 53 | ------------- |
| 54 | |
| 55 | procedure Further (Item : in Stream_Element_Array) is |
| 56 | |
| 57 | procedure Compare (Item : in Stream_Element_Array); |
| 58 | |
| 59 | ------------- |
| 60 | -- Compare -- |
| 61 | ------------- |
| 62 | |
| 63 | procedure Compare (Item : in Stream_Element_Array) is |
| 64 | Next_First : Stream_Element_Offset := Compare_First + Item'Length; |
| 65 | begin |
| 66 | if Buffer (Compare_First .. Next_First - 1) /= Item then |
| 67 | raise Program_Error; |
| 68 | end if; |
| 69 | |
| 70 | Compare_First := Next_First; |
| 71 | end Compare; |
| 72 | |
| 73 | procedure Compare_Write is new ZLib.Write (Write => Compare); |
| 74 | begin |
| 75 | Compare_Write (Inflate, Item, No_Flush); |
| 76 | end Further; |
| 77 | |
| 78 | ----------------- |
| 79 | -- Read_Buffer -- |
| 80 | ----------------- |
| 81 | |
| 82 | procedure Read_Buffer |
| 83 | (Item : out Ada.Streams.Stream_Element_Array; |
| 84 | Last : out Ada.Streams.Stream_Element_Offset) |
| 85 | is |
| 86 | Buff_Diff : Stream_Element_Offset := Buffer'Last - Buffer_First; |
| 87 | Next_First : Stream_Element_Offset; |
| 88 | begin |
| 89 | if Item'Length <= Buff_Diff then |
| 90 | Last := Item'Last; |
| 91 | |
| 92 | Next_First := Buffer_First + Item'Length; |
| 93 | |
| 94 | Item := Buffer (Buffer_First .. Next_First - 1); |
| 95 | |
| 96 | Buffer_First := Next_First; |
| 97 | else |
| 98 | Last := Item'First + Buff_Diff; |
| 99 | Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last); |
| 100 | Buffer_First := Buffer'Last + 1; |
| 101 | end if; |
| 102 | end Read_Buffer; |
| 103 | |
| 104 | procedure Translate is new Generic_Translate |
| 105 | (Data_In => Read_Buffer, |
| 106 | Data_Out => Further); |
| 107 | |
| 108 | begin |
| 109 | Random_Elements.Reset (Gen); |
| 110 | |
| 111 | Buffer := (others => 20); |
| 112 | |
| 113 | Main : loop |
| 114 | for J in Buffer'Range loop |
| 115 | Buffer (J) := Random_Elements.Random (Gen); |
| 116 | |
| 117 | Deflate_Init (Deflate); |
| 118 | Inflate_Init (Inflate); |
| 119 | |
| 120 | Buffer_First := Buffer'First; |
| 121 | Compare_First := Buffer'First; |
| 122 | |
| 123 | Translate (Deflate); |
| 124 | |
| 125 | if Compare_First /= Buffer'Last + 1 then |
| 126 | raise Program_Error; |
| 127 | end if; |
| 128 | |
| 129 | Ada.Text_IO.Put_Line |
| 130 | (Ada.Task_Identification.Image |
| 131 | (Ada.Task_Identification.Current_Task) |
| 132 | & Stream_Element_Offset'Image (J) |
| 133 | & ZLib.Count'Image (Total_Out (Deflate))); |
| 134 | |
| 135 | Close (Deflate); |
| 136 | Close (Inflate); |
| 137 | |
| 138 | exit Main when Stop; |
| 139 | end loop; |
| 140 | end loop Main; |
| 141 | exception |
| 142 | when E : others => |
| 143 | Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E)); |
| 144 | Stop := True; |
| 145 | end Test_Task; |
| 146 | |
| 147 | Test : array (1 .. 4) of Test_Task; |
| 148 | |
| 149 | pragma Unreferenced (Test); |
| 150 | |
| 151 | Dummy : Character; |
| 152 | |
| 153 | begin |
| 154 | Ada.Text_IO.Get_Immediate (Dummy); |
| 155 | Stop := True; |
| 156 | end MTest; |