common/dist/zlib/contrib/ada/read.adb

   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
   9 --  Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp
  10
  11 --  Test/demo program for the generic read interface.
  12
  13 with Ada.Numerics.Discrete_Random;
  14 with Ada.Streams;
  15 with Ada.Text_IO;
  16
  17 with ZLib;
  18
  19 procedure Read is
  20
  21    use Ada.Streams;
  22
  23    ------------------------------------
  24    --  Test configuration parameters --
  25    ------------------------------------
  26
  27    File_Size   : Stream_Element_Offset := 100_000;
  28
  29    Continuous  : constant Boolean          := False;
  30    --  If this constant is True, the test would be repeated again and again,
  31    --  with increment File_Size for every iteration.
  32
  33    Header      : constant ZLib.Header_Type := ZLib.Default;
  34    --  Do not use Header other than Default in ZLib versions 1.1.4 and older.
  35
  36    Init_Random : constant := 8;
  37    --  We are using the same random sequence, in case of we catch bug,
  38    --  so we would be able to reproduce it.
  39
  40    -- End --
  41
  42    Pack_Size : Stream_Element_Offset;
  43    Offset    : Stream_Element_Offset;
  44
  45    Filter     : ZLib.Filter_Type;
  46
  47    subtype Visible_Symbols
  48       is Stream_Element range 16#20# .. 16#7E#;
  49
  50    package Random_Elements is new
  51       Ada.Numerics.Discrete_Random (Visible_Symbols);
  52
  53    Gen : Random_Elements.Generator;
  54    Period  : constant Stream_Element_Offset := 200;
  55    --  Period constant variable for random generator not to be very random.
  56    --  Bigger period, harder random.
  57
  58    Read_Buffer : Stream_Element_Array (1 .. 2048);
  59    Read_First  : Stream_Element_Offset;
  60    Read_Last   : Stream_Element_Offset;
  61
  62    procedure Reset;
  63
  64    procedure Read
  65      (Item : out Stream_Element_Array;
  66       Last : out Stream_Element_Offset);
  67    --  this procedure is for generic instantiation of
  68    --  ZLib.Read
  69    --  reading data from the File_In.
  70
  71    procedure Read is new ZLib.Read
  72                            (Read,
  73                             Read_Buffer,
  74                             Rest_First => Read_First,
  75                             Rest_Last  => Read_Last);
  76
  77    ----------
  78    -- Read --
  79    ----------
  80
  81    procedure Read
  82      (Item : out Stream_Element_Array;
  83       Last : out Stream_Element_Offset) is
  84    begin
  85       Last := Stream_Element_Offset'Min
  86                (Item'Last,
  87                 Item'First + File_Size - Offset);
  88
  89       for J in Item'First .. Last loop
  90          if J < Item'First + Period then
  91             Item (J) := Random_Elements.Random (Gen);
  92          else
  93             Item (J) := Item (J - Period);
  94          end if;
  95
  96          Offset   := Offset + 1;
  97       end loop;
  98    end Read;
  99
 100    -----------
 101    -- Reset --
 102    -----------
 103
 104    procedure Reset is
 105    begin
 106       Random_Elements.Reset (Gen, Init_Random);
 107       Pack_Size := 0;
 108       Offset := 1;
 109       Read_First := Read_Buffer'Last + 1;
 110       Read_Last  := Read_Buffer'Last;
 111    end Reset;
 112
 113 begin
 114    Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
 115
 116    loop
 117       for Level in ZLib.Compression_Level'Range loop
 118
 119          Ada.Text_IO.Put ("Level ="
 120             & ZLib.Compression_Level'Image (Level));
 121
 122          --  Deflate using generic instantiation.
 123
 124          ZLib.Deflate_Init
 125                (Filter,
 126                 Level,
 127                 Header => Header);
 128
 129          Reset;
 130
 131          Ada.Text_IO.Put
 132            (Stream_Element_Offset'Image (File_Size) & " ->");
 133
 134          loop
 135             declare
 136                Buffer : Stream_Element_Array (1 .. 1024);
 137                Last   : Stream_Element_Offset;
 138             begin
 139                Read (Filter, Buffer, Last);
 140
 141                Pack_Size := Pack_Size + Last - Buffer'First + 1;
 142
 143                exit when Last < Buffer'Last;
 144             end;
 145          end loop;
 146
 147          Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));
 148
 149          ZLib.Close (Filter);
 150       end loop;
 151
 152       exit when not Continuous;
 153
 154       File_Size := File_Size + 1;
 155    end loop;
 156 end Read;