"Fossies" - the Fresh Open Source Software Archive

Member "muscle/zlib/zlib/contrib/ada/test.adb" (28 Nov 2019, 13180 Bytes) of package /linux/privat/muscle7.52.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) ADA95 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

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