buffer_demo.adb revision 1.1.1.3 1 1.1 christos ----------------------------------------------------------------
2 1.1 christos -- ZLib for Ada thick binding. --
3 1.1 christos -- --
4 1.1 christos -- Copyright (C) 2002-2004 Dmitriy Anisimkov --
5 1.1 christos -- --
6 1.1 christos -- Open source license information is in the zlib.ads file. --
7 1.1 christos ----------------------------------------------------------------
8 1.1 christos --
9 1.1.1.3 christos -- Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp
10 1.1 christos
11 1.1 christos -- This demo program provided by Dr Steve Sangwine <sjs (a] essex.ac.uk>
12 1.1 christos --
13 1.1 christos -- Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
14 1.1 christos -- of exactly the correct size is used for decompressed data, and the last
15 1.1 christos -- few bytes passed in to Zlib are checksum bytes.
16 1.1 christos
17 1.1 christos -- This program compresses a string of text, and then decompresses the
18 1.1 christos -- compressed text into a buffer of the same size as the original text.
19 1.1 christos
20 1.1 christos with Ada.Streams; use Ada.Streams;
21 1.1 christos with Ada.Text_IO;
22 1.1 christos
23 1.1 christos with ZLib; use ZLib;
24 1.1 christos
25 1.1 christos procedure Buffer_Demo is
26 1.1 christos EOL : Character renames ASCII.LF;
27 1.1 christos Text : constant String
28 1.1 christos := "Four score and seven years ago our fathers brought forth," & EOL &
29 1.1 christos "upon this continent, a new nation, conceived in liberty," & EOL &
30 1.1 christos "and dedicated to the proposition that `all men are created equal'.";
31 1.1 christos
32 1.1 christos Source : Stream_Element_Array (1 .. Text'Length);
33 1.1 christos for Source'Address use Text'Address;
34 1.1 christos
35 1.1 christos begin
36 1.1 christos Ada.Text_IO.Put (Text);
37 1.1 christos Ada.Text_IO.New_Line;
38 1.1 christos Ada.Text_IO.Put_Line
39 1.1 christos ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");
40 1.1 christos
41 1.1 christos declare
42 1.1 christos Compressed_Data : Stream_Element_Array (1 .. Text'Length);
43 1.1 christos L : Stream_Element_Offset;
44 1.1 christos begin
45 1.1 christos Compress : declare
46 1.1 christos Compressor : Filter_Type;
47 1.1 christos I : Stream_Element_Offset;
48 1.1 christos begin
49 1.1 christos Deflate_Init (Compressor);
50 1.1 christos
51 1.1 christos -- Compress the whole of T at once.
52 1.1 christos
53 1.1 christos Translate (Compressor, Source, I, Compressed_Data, L, Finish);
54 1.1 christos pragma Assert (I = Source'Last);
55 1.1 christos
56 1.1 christos Close (Compressor);
57 1.1 christos
58 1.1 christos Ada.Text_IO.Put_Line
59 1.1 christos ("Compressed size : "
60 1.1 christos & Stream_Element_Offset'Image (L) & " bytes");
61 1.1 christos end Compress;
62 1.1 christos
63 1.1 christos -- Now we decompress the data, passing short blocks of data to Zlib
64 1.1 christos -- (because this demonstrates the problem - the last block passed will
65 1.1 christos -- contain checksum information and there will be no output, only a
66 1.1 christos -- check inside Zlib that the checksum is correct).
67 1.1 christos
68 1.1 christos Decompress : declare
69 1.1 christos Decompressor : Filter_Type;
70 1.1 christos
71 1.1 christos Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);
72 1.1 christos
73 1.1 christos Block_Size : constant := 4;
74 1.1 christos -- This makes sure that the last block contains
75 1.1 christos -- only Adler checksum data.
76 1.1 christos
77 1.1 christos P : Stream_Element_Offset := Compressed_Data'First - 1;
78 1.1 christos O : Stream_Element_Offset;
79 1.1 christos begin
80 1.1 christos Inflate_Init (Decompressor);
81 1.1 christos
82 1.1 christos loop
83 1.1 christos Translate
84 1.1 christos (Decompressor,
85 1.1 christos Compressed_Data
86 1.1 christos (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
87 1.1 christos P,
88 1.1 christos Uncompressed_Data
89 1.1 christos (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
90 1.1 christos O,
91 1.1 christos No_Flush);
92 1.1 christos
93 1.1 christos Ada.Text_IO.Put_Line
94 1.1 christos ("Total in : " & Count'Image (Total_In (Decompressor)) &
95 1.1 christos ", out : " & Count'Image (Total_Out (Decompressor)));
96 1.1 christos
97 1.1 christos exit when P = L;
98 1.1 christos end loop;
99 1.1 christos
100 1.1 christos Ada.Text_IO.New_Line;
101 1.1 christos Ada.Text_IO.Put_Line
102 1.1 christos ("Decompressed text matches original text : "
103 1.1 christos & Boolean'Image (Uncompressed_Data = Source));
104 1.1 christos end Decompress;
105 1.1 christos end;
106 1.1 christos end Buffer_Demo;
107