]>
Commit | Line | Data |
---|---|---|
176ba833 TT |
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 | ---------------------------------------------------------------- | |
3ec980b1 TT |
8 | -- Continuous test for ZLib multithreading. If the test would fail |
9 | -- we should provide thread safe allocation routines for the Z_Stream. | |
176ba833 | 10 | -- |
3ec980b1 | 11 | -- $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $ |
176ba833 TT |
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 | ||
3ec980b1 TT |
151 | Dummy : Character; |
152 | ||
176ba833 | 153 | begin |
3ec980b1 TT |
154 | Ada.Text_IO.Get_Immediate (Dummy); |
155 | Stop := True; | |
176ba833 | 156 | end MTest; |