annotate src/zlib-1.2.8/contrib/ada/read.adb @ 169:223a55898ab9 tip default

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