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