Home | History | Annotate | Line # | Download | only in ada
      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.3  christos --  Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp 
     10      1.1  christos 
     11      1.1  christos --  The program has a few aims.
     12      1.1  christos --  1. Test ZLib.Ada95 thick binding functionality.
     13      1.1  christos --  2. Show the example of use main functionality of the ZLib.Ada95 binding.
     14      1.1  christos --  3. Build this program automatically compile all ZLib.Ada95 packages under
     15      1.1  christos --     GNAT Ada95 compiler.
     16      1.1  christos 
     17      1.1  christos with ZLib.Streams;
     18      1.1  christos with Ada.Streams.Stream_IO;
     19      1.1  christos with Ada.Numerics.Discrete_Random;
     20      1.1  christos 
     21      1.1  christos with Ada.Text_IO;
     22      1.1  christos 
     23      1.1  christos with Ada.Calendar;
     24      1.1  christos 
     25      1.1  christos procedure Test is
     26      1.1  christos 
     27      1.1  christos    use Ada.Streams;
     28      1.1  christos    use Stream_IO;
     29      1.1  christos 
     30      1.1  christos    ------------------------------------
     31      1.1  christos    --  Test configuration parameters --
     32      1.1  christos    ------------------------------------
     33      1.1  christos 
     34      1.1  christos    File_Size   : Count   := 100_000;
     35      1.1  christos    Continuous  : constant Boolean := False;
     36      1.1  christos 
     37      1.1  christos    Header      : constant ZLib.Header_Type := ZLib.Default;
     38      1.1  christos                                               --  ZLib.None;
     39      1.1  christos                                               --  ZLib.Auto;
     40      1.1  christos                                               --  ZLib.GZip;
     41      1.1  christos    --  Do not use Header other then Default in ZLib versions 1.1.4
     42      1.1  christos    --  and older.
     43      1.1  christos 
     44      1.1  christos    Strategy    : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
     45      1.1  christos    Init_Random : constant := 10;
     46      1.1  christos 
     47      1.1  christos    -- End --
     48      1.1  christos 
     49      1.1  christos    In_File_Name  : constant String := "testzlib.in";
     50      1.1  christos    --  Name of the input file
     51      1.1  christos 
     52      1.1  christos    Z_File_Name   : constant String := "testzlib.zlb";
     53      1.1  christos    --  Name of the compressed file.
     54      1.1  christos 
     55      1.1  christos    Out_File_Name : constant String := "testzlib.out";
     56      1.1  christos    --  Name of the decompressed file.
     57      1.1  christos 
     58      1.1  christos    File_In   : File_Type;
     59      1.1  christos    File_Out  : File_Type;
     60      1.1  christos    File_Back : File_Type;
     61      1.1  christos    File_Z    : ZLib.Streams.Stream_Type;
     62      1.1  christos 
     63      1.1  christos    Filter : ZLib.Filter_Type;
     64      1.1  christos 
     65      1.1  christos    Time_Stamp : Ada.Calendar.Time;
     66      1.1  christos 
     67      1.1  christos    procedure Generate_File;
     68  1.1.1.4  christos    --  Generate file of specified size with some random data.
     69      1.1  christos    --  The random data is repeatable, for the good compression.
     70      1.1  christos 
     71      1.1  christos    procedure Compare_Streams
     72      1.1  christos      (Left, Right : in out Root_Stream_Type'Class);
     73  1.1.1.4  christos    --  The procedure comparing data in 2 streams.
     74      1.1  christos    --  It is for compare data before and after compression/decompression.
     75      1.1  christos 
     76      1.1  christos    procedure Compare_Files (Left, Right : String);
     77      1.1  christos    --  Compare files. Based on the Compare_Streams.
     78      1.1  christos 
     79      1.1  christos    procedure Copy_Streams
     80      1.1  christos      (Source, Target : in out Root_Stream_Type'Class;
     81      1.1  christos       Buffer_Size    : in     Stream_Element_Offset := 1024);
     82      1.1  christos    --  Copying data from one stream to another. It is for test stream
     83      1.1  christos    --  interface of the library.
     84      1.1  christos 
     85      1.1  christos    procedure Data_In
     86      1.1  christos      (Item : out Stream_Element_Array;
     87      1.1  christos       Last : out Stream_Element_Offset);
     88      1.1  christos    --  this procedure is for generic instantiation of
     89      1.1  christos    --  ZLib.Generic_Translate.
     90      1.1  christos    --  reading data from the File_In.
     91      1.1  christos 
     92      1.1  christos    procedure Data_Out (Item : in Stream_Element_Array);
     93      1.1  christos    --  this procedure is for generic instantiation of
     94      1.1  christos    --  ZLib.Generic_Translate.
     95      1.1  christos    --  writing data to the File_Out.
     96      1.1  christos 
     97      1.1  christos    procedure Stamp;
     98      1.1  christos    --  Store the timestamp to the local variable.
     99      1.1  christos 
    100      1.1  christos    procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
    101      1.1  christos    --  Print the time statistic with the message.
    102      1.1  christos 
    103      1.1  christos    procedure Translate is new ZLib.Generic_Translate
    104      1.1  christos                                 (Data_In  => Data_In,
    105      1.1  christos                                  Data_Out => Data_Out);
    106      1.1  christos    --  This procedure is moving data from File_In to File_Out
    107      1.1  christos    --  with compression or decompression, depend on initialization of
    108      1.1  christos    --  Filter parameter.
    109      1.1  christos 
    110      1.1  christos    -------------------
    111      1.1  christos    -- Compare_Files --
    112      1.1  christos    -------------------
    113      1.1  christos 
    114      1.1  christos    procedure Compare_Files (Left, Right : String) is
    115      1.1  christos       Left_File, Right_File : File_Type;
    116      1.1  christos    begin
    117      1.1  christos       Open (Left_File, In_File, Left);
    118      1.1  christos       Open (Right_File, In_File, Right);
    119      1.1  christos       Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
    120      1.1  christos       Close (Left_File);
    121      1.1  christos       Close (Right_File);
    122      1.1  christos    end Compare_Files;
    123      1.1  christos 
    124      1.1  christos    ---------------------
    125      1.1  christos    -- Compare_Streams --
    126      1.1  christos    ---------------------
    127      1.1  christos 
    128      1.1  christos    procedure Compare_Streams
    129      1.1  christos      (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
    130      1.1  christos    is
    131      1.1  christos       Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
    132      1.1  christos       Left_Last, Right_Last : Stream_Element_Offset;
    133      1.1  christos    begin
    134      1.1  christos       loop
    135      1.1  christos          Read (Left, Left_Buffer, Left_Last);
    136      1.1  christos          Read (Right, Right_Buffer, Right_Last);
    137      1.1  christos 
    138      1.1  christos          if Left_Last /= Right_Last then
    139      1.1  christos             Ada.Text_IO.Put_Line ("Compare error :"
    140      1.1  christos               & Stream_Element_Offset'Image (Left_Last)
    141      1.1  christos               & " /= "
    142      1.1  christos               & Stream_Element_Offset'Image (Right_Last));
    143      1.1  christos 
    144      1.1  christos             raise Constraint_Error;
    145      1.1  christos 
    146      1.1  christos          elsif Left_Buffer (0 .. Left_Last)
    147      1.1  christos                /= Right_Buffer (0 .. Right_Last)
    148      1.1  christos          then
    149      1.1  christos             Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
    150      1.1  christos             raise Constraint_Error;
    151      1.1  christos 
    152      1.1  christos          end if;
    153      1.1  christos 
    154      1.1  christos          exit when Left_Last < Left_Buffer'Last;
    155      1.1  christos       end loop;
    156      1.1  christos    end Compare_Streams;
    157      1.1  christos 
    158      1.1  christos    ------------------
    159      1.1  christos    -- Copy_Streams --
    160      1.1  christos    ------------------
    161      1.1  christos 
    162      1.1  christos    procedure Copy_Streams
    163      1.1  christos      (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
    164      1.1  christos       Buffer_Size    : in     Stream_Element_Offset := 1024)
    165      1.1  christos    is
    166      1.1  christos       Buffer : Stream_Element_Array (1 .. Buffer_Size);
    167      1.1  christos       Last   : Stream_Element_Offset;
    168      1.1  christos    begin
    169      1.1  christos       loop
    170      1.1  christos          Read  (Source, Buffer, Last);
    171      1.1  christos          Write (Target, Buffer (1 .. Last));
    172      1.1  christos 
    173      1.1  christos          exit when Last < Buffer'Last;
    174      1.1  christos       end loop;
    175      1.1  christos    end Copy_Streams;
    176      1.1  christos 
    177      1.1  christos    -------------
    178      1.1  christos    -- Data_In --
    179      1.1  christos    -------------
    180      1.1  christos 
    181      1.1  christos    procedure Data_In
    182      1.1  christos      (Item : out Stream_Element_Array;
    183      1.1  christos       Last : out Stream_Element_Offset) is
    184      1.1  christos    begin
    185      1.1  christos       Read (File_In, Item, Last);
    186      1.1  christos    end Data_In;
    187      1.1  christos 
    188      1.1  christos    --------------
    189      1.1  christos    -- Data_Out --
    190      1.1  christos    --------------
    191      1.1  christos 
    192      1.1  christos    procedure Data_Out (Item : in Stream_Element_Array) is
    193      1.1  christos    begin
    194      1.1  christos       Write (File_Out, Item);
    195      1.1  christos    end Data_Out;
    196      1.1  christos 
    197      1.1  christos    -------------------
    198      1.1  christos    -- Generate_File --
    199      1.1  christos    -------------------
    200      1.1  christos 
    201      1.1  christos    procedure Generate_File is
    202      1.1  christos       subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;
    203      1.1  christos 
    204      1.1  christos       package Random_Elements is
    205      1.1  christos          new Ada.Numerics.Discrete_Random (Visible_Symbols);
    206      1.1  christos 
    207      1.1  christos       Gen    : Random_Elements.Generator;
    208      1.1  christos       Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;
    209      1.1  christos 
    210      1.1  christos       Buffer_Count : constant Count := File_Size / Buffer'Length;
    211      1.1  christos       --  Number of same buffers in the packet.
    212      1.1  christos 
    213      1.1  christos       Density : constant Count := 30; --  from 0 to Buffer'Length - 2;
    214      1.1  christos 
    215      1.1  christos       procedure Fill_Buffer (J, D : in Count);
    216      1.1  christos       --  Change the part of the buffer.
    217      1.1  christos 
    218      1.1  christos       -----------------
    219      1.1  christos       -- Fill_Buffer --
    220      1.1  christos       -----------------
    221      1.1  christos 
    222      1.1  christos       procedure Fill_Buffer (J, D : in Count) is
    223      1.1  christos       begin
    224      1.1  christos          for K in 0 .. D loop
    225      1.1  christos             Buffer
    226      1.1  christos               (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
    227      1.1  christos              := Random_Elements.Random (Gen);
    228      1.1  christos 
    229      1.1  christos          end loop;
    230      1.1  christos       end Fill_Buffer;
    231      1.1  christos 
    232      1.1  christos    begin
    233      1.1  christos       Random_Elements.Reset (Gen, Init_Random);
    234      1.1  christos 
    235      1.1  christos       Create (File_In, Out_File, In_File_Name);
    236      1.1  christos 
    237      1.1  christos       Fill_Buffer (1, Buffer'Length - 2);
    238      1.1  christos 
    239      1.1  christos       for J in 1 .. Buffer_Count loop
    240      1.1  christos          Write (File_In, Buffer);
    241      1.1  christos 
    242      1.1  christos          Fill_Buffer (J, Density);
    243      1.1  christos       end loop;
    244      1.1  christos 
    245      1.1  christos       --  fill remain size.
    246      1.1  christos 
    247      1.1  christos       Write
    248      1.1  christos         (File_In,
    249      1.1  christos          Buffer
    250      1.1  christos            (1 .. Stream_Element_Offset
    251      1.1  christos                    (File_Size - Buffer'Length * Buffer_Count)));
    252      1.1  christos 
    253      1.1  christos       Flush (File_In);
    254      1.1  christos       Close (File_In);
    255      1.1  christos    end Generate_File;
    256      1.1  christos 
    257      1.1  christos    ---------------------
    258      1.1  christos    -- Print_Statistic --
    259      1.1  christos    ---------------------
    260      1.1  christos 
    261      1.1  christos    procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
    262      1.1  christos       use Ada.Calendar;
    263      1.1  christos       use Ada.Text_IO;
    264      1.1  christos 
    265      1.1  christos       package Count_IO is new Integer_IO (ZLib.Count);
    266      1.1  christos 
    267      1.1  christos       Curr_Dur : Duration := Clock - Time_Stamp;
    268      1.1  christos    begin
    269      1.1  christos       Put (Msg);
    270      1.1  christos 
    271      1.1  christos       Set_Col (20);
    272      1.1  christos       Ada.Text_IO.Put ("size =");
    273      1.1  christos 
    274      1.1  christos       Count_IO.Put
    275      1.1  christos         (Data_Size,
    276      1.1  christos          Width => Stream_IO.Count'Image (File_Size)'Length);
    277      1.1  christos 
    278      1.1  christos       Put_Line (" duration =" & Duration'Image (Curr_Dur));
    279      1.1  christos    end Print_Statistic;
    280      1.1  christos 
    281      1.1  christos    -----------
    282      1.1  christos    -- Stamp --
    283      1.1  christos    -----------
    284      1.1  christos 
    285      1.1  christos    procedure Stamp is
    286      1.1  christos    begin
    287      1.1  christos       Time_Stamp := Ada.Calendar.Clock;
    288      1.1  christos    end Stamp;
    289      1.1  christos 
    290      1.1  christos begin
    291      1.1  christos    Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);
    292      1.1  christos 
    293      1.1  christos    loop
    294      1.1  christos       Generate_File;
    295      1.1  christos 
    296      1.1  christos       for Level in ZLib.Compression_Level'Range loop
    297      1.1  christos 
    298      1.1  christos          Ada.Text_IO.Put_Line ("Level ="
    299      1.1  christos             & ZLib.Compression_Level'Image (Level));
    300      1.1  christos 
    301      1.1  christos          --  Test generic interface.
    302      1.1  christos          Open   (File_In, In_File, In_File_Name);
    303      1.1  christos          Create (File_Out, Out_File, Z_File_Name);
    304      1.1  christos 
    305      1.1  christos          Stamp;
    306      1.1  christos 
    307      1.1  christos          --  Deflate using generic instantiation.
    308      1.1  christos 
    309      1.1  christos          ZLib.Deflate_Init
    310      1.1  christos                (Filter   => Filter,
    311      1.1  christos                 Level    => Level,
    312      1.1  christos                 Strategy => Strategy,
    313      1.1  christos                 Header   => Header);
    314      1.1  christos 
    315      1.1  christos          Translate (Filter);
    316      1.1  christos          Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
    317      1.1  christos          ZLib.Close (Filter);
    318      1.1  christos 
    319      1.1  christos          Close (File_In);
    320      1.1  christos          Close (File_Out);
    321      1.1  christos 
    322      1.1  christos          Open   (File_In, In_File, Z_File_Name);
    323      1.1  christos          Create (File_Out, Out_File, Out_File_Name);
    324      1.1  christos 
    325      1.1  christos          Stamp;
    326      1.1  christos 
    327      1.1  christos          --  Inflate using generic instantiation.
    328      1.1  christos 
    329      1.1  christos          ZLib.Inflate_Init (Filter, Header => Header);
    330      1.1  christos 
    331      1.1  christos          Translate (Filter);
    332      1.1  christos          Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));
    333      1.1  christos 
    334      1.1  christos          ZLib.Close (Filter);
    335      1.1  christos 
    336      1.1  christos          Close (File_In);
    337      1.1  christos          Close (File_Out);
    338      1.1  christos 
    339      1.1  christos          Compare_Files (In_File_Name, Out_File_Name);
    340      1.1  christos 
    341      1.1  christos          --  Test stream interface.
    342      1.1  christos 
    343      1.1  christos          --  Compress to the back stream.
    344      1.1  christos 
    345      1.1  christos          Open   (File_In, In_File, In_File_Name);
    346      1.1  christos          Create (File_Back, Out_File, Z_File_Name);
    347      1.1  christos 
    348      1.1  christos          Stamp;
    349      1.1  christos 
    350      1.1  christos          ZLib.Streams.Create
    351      1.1  christos            (Stream          => File_Z,
    352      1.1  christos             Mode            => ZLib.Streams.Out_Stream,
    353      1.1  christos             Back            => ZLib.Streams.Stream_Access
    354      1.1  christos                                  (Stream (File_Back)),
    355      1.1  christos             Back_Compressed => True,
    356      1.1  christos             Level           => Level,
    357      1.1  christos             Strategy        => Strategy,
    358      1.1  christos             Header          => Header);
    359      1.1  christos 
    360      1.1  christos          Copy_Streams
    361      1.1  christos            (Source => Stream (File_In).all,
    362      1.1  christos             Target => File_Z);
    363      1.1  christos 
    364      1.1  christos          --  Flushing internal buffers to the back stream.
    365      1.1  christos 
    366      1.1  christos          ZLib.Streams.Flush (File_Z, ZLib.Finish);
    367      1.1  christos 
    368      1.1  christos          Print_Statistic ("Write compress",
    369      1.1  christos                           ZLib.Streams.Write_Total_Out (File_Z));
    370      1.1  christos 
    371      1.1  christos          ZLib.Streams.Close (File_Z);
    372      1.1  christos 
    373      1.1  christos          Close (File_In);
    374      1.1  christos          Close (File_Back);
    375      1.1  christos 
    376      1.1  christos          --  Compare reading from original file and from
    377      1.1  christos          --  decompression stream.
    378      1.1  christos 
    379      1.1  christos          Open (File_In,   In_File, In_File_Name);
    380      1.1  christos          Open (File_Back, In_File, Z_File_Name);
    381      1.1  christos 
    382      1.1  christos          ZLib.Streams.Create
    383      1.1  christos            (Stream          => File_Z,
    384      1.1  christos             Mode            => ZLib.Streams.In_Stream,
    385      1.1  christos             Back            => ZLib.Streams.Stream_Access
    386      1.1  christos                                  (Stream (File_Back)),
    387      1.1  christos             Back_Compressed => True,
    388      1.1  christos             Header          => Header);
    389      1.1  christos 
    390      1.1  christos          Stamp;
    391      1.1  christos          Compare_Streams (Stream (File_In).all, File_Z);
    392      1.1  christos 
    393      1.1  christos          Print_Statistic ("Read decompress",
    394      1.1  christos                           ZLib.Streams.Read_Total_Out (File_Z));
    395      1.1  christos 
    396      1.1  christos          ZLib.Streams.Close (File_Z);
    397      1.1  christos          Close (File_In);
    398      1.1  christos          Close (File_Back);
    399      1.1  christos 
    400      1.1  christos          --  Compress by reading from compression stream.
    401      1.1  christos 
    402      1.1  christos          Open (File_Back, In_File, In_File_Name);
    403      1.1  christos          Create (File_Out, Out_File, Z_File_Name);
    404      1.1  christos 
    405      1.1  christos          ZLib.Streams.Create
    406      1.1  christos            (Stream          => File_Z,
    407      1.1  christos             Mode            => ZLib.Streams.In_Stream,
    408      1.1  christos             Back            => ZLib.Streams.Stream_Access
    409      1.1  christos                                  (Stream (File_Back)),
    410      1.1  christos             Back_Compressed => False,
    411      1.1  christos             Level           => Level,
    412      1.1  christos             Strategy        => Strategy,
    413      1.1  christos             Header          => Header);
    414      1.1  christos 
    415      1.1  christos          Stamp;
    416      1.1  christos          Copy_Streams
    417      1.1  christos            (Source => File_Z,
    418      1.1  christos             Target => Stream (File_Out).all);
    419      1.1  christos 
    420      1.1  christos          Print_Statistic ("Read compress",
    421      1.1  christos                           ZLib.Streams.Read_Total_Out (File_Z));
    422      1.1  christos 
    423      1.1  christos          ZLib.Streams.Close (File_Z);
    424      1.1  christos 
    425      1.1  christos          Close (File_Out);
    426      1.1  christos          Close (File_Back);
    427      1.1  christos 
    428      1.1  christos          --  Decompress to decompression stream.
    429      1.1  christos 
    430      1.1  christos          Open   (File_In,   In_File, Z_File_Name);
    431      1.1  christos          Create (File_Back, Out_File, Out_File_Name);
    432      1.1  christos 
    433      1.1  christos          ZLib.Streams.Create
    434      1.1  christos            (Stream          => File_Z,
    435      1.1  christos             Mode            => ZLib.Streams.Out_Stream,
    436      1.1  christos             Back            => ZLib.Streams.Stream_Access
    437      1.1  christos                                  (Stream (File_Back)),
    438      1.1  christos             Back_Compressed => False,
    439      1.1  christos             Header          => Header);
    440      1.1  christos 
    441      1.1  christos          Stamp;
    442      1.1  christos 
    443      1.1  christos          Copy_Streams
    444      1.1  christos            (Source => Stream (File_In).all,
    445      1.1  christos             Target => File_Z);
    446      1.1  christos 
    447      1.1  christos          Print_Statistic ("Write decompress",
    448      1.1  christos                           ZLib.Streams.Write_Total_Out (File_Z));
    449      1.1  christos 
    450      1.1  christos          ZLib.Streams.Close (File_Z);
    451      1.1  christos          Close (File_In);
    452      1.1  christos          Close (File_Back);
    453      1.1  christos 
    454      1.1  christos          Compare_Files (In_File_Name, Out_File_Name);
    455      1.1  christos       end loop;
    456      1.1  christos 
    457      1.1  christos       Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");
    458      1.1  christos 
    459      1.1  christos       exit when not Continuous;
    460      1.1  christos 
    461      1.1  christos       File_Size := File_Size + 1;
    462      1.1  christos    end loop;
    463      1.1  christos end Test;
    464