Home | History | Annotate | Line # | Download | only in ada
test.adb revision 1.1
      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  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  christos    --  Generate file of spetsified 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  christos    --  The procedure compearing 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