summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxaa010.a
blob: 5678aee6bcf4204f5aa578b3e0109ee2873414cd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
-- CXAA010.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that the operations defined in package Ada.Text_IO.Decimal_IO
--      are available, and that they function correctly when used for the
--      input/output of Decimal types.
--
-- TEST DESCRIPTION:
--      This test demonstrates the Put and Get procedures found in the
--      generic package Ada.Text_IO.Decimal_IO.  Both Put and Get are
--      overloaded to allow placement or extraction of decimal values 
--      to/from a text file or a string.  This test demonstrates both forms
--      of each subprogram.  
--      The test defines an array of records containing decimal value
--      and string component fields.  All component values are placed in a 
--      Text_IO file, with the decimal values being placed there using the 
--      version of Put defined for files, and using user-specified formatting 
--      parameters.  The data is later extracted from the file, with the 
--      decimal values being removed using the version of Get defined for
--      files.  Decimal values are then written to strings, using the 
--      appropriate Put procedure.  Finally, extraction of the decimal data
--      from the strings completes the evaluation of the Decimal_IO package
--      subprograms.
--      The reconstructed data is verified at the end of the test against the
--      data originally written to the file.
--
-- APPLICABILITY CRITERIA: 
--      Applicable to all implementations capable of supporting external
--      Text_IO files and Decimal Fixed Point Types
-- 
--      All implementations must attempt to compile this test.
--
--      For implementations validating against Information Systems Annex (F):
--        this test must execute and report PASSED.
--
--      For implementations not validating against Annex F:
--        this test may report compile time errors at one or more points
--        indicated by "-- ANX-F RQMT", in which case it may be graded as inapplicable.
--        Otherwise, the test must execute and report PASSED.
--
--       
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      20 Feb 95   SAIC    Modified test to allow for Use_Error/Name_Error
--                          generation by an implementation not supporting
--                          Text_IO operations.
--      14 Nov 95   SAIC    Corrected string indexing for ACVC 2.0.1.
--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
--      16 FEB 98   EDS     Modified documentation.
--!

with Ada.Text_IO;
with Report;

procedure CXAA010 is
   use Ada.Text_IO;
   Tax_Roll      : Ada.Text_IO.File_Type;
   Tax_Roll_Name : constant String :=
                           Report.Legal_File_Name ( Nam => "CXAA010" );
   Incomplete : exception;
begin

   Report.Test ("CXAA010", "Check that the operations defined in package " &
                           "Ada.Text_IO.Decimal_IO are available, and "    &
                           "that they function correctly when used for "   &
                           "the input/output of Decimal types");

   Test_for_Decimal_IO_Support:
   begin

      -- An implementation that does not support Text_IO creation or naming
      -- of external files in a particular environment will raise Use_Error 
      -- or Name_Error on a call to Text_IO Create. This block statement 
      -- encloses a call to Create, which should produce an exception in a 
      -- non-supportive environment.  Either of these exceptions will be 
      -- handled to produce a Not_Applicable result.

      Ada.Text_IO.Create (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);

   exception

       when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
          Report.Not_Applicable
             ( "Files not supported - Create as Out_File for Text_IO" );
          raise Incomplete;

   end Test_for_Decimal_IO_Support;

   Taxation:
   declare

      ID_Length           : constant :=  5;
      Price_String_Length : constant :=  5;
      Value_String_Length : constant :=  6;
      Total_String_Length : constant := 20;
      Spacer              : constant String := "  ";  -- Two blanks.

      type Price_Type     is delta 0.1  digits 4;              -- ANX-F RQMT
      type Value_Type     is delta 0.01 digits 5;              -- ANX-F RQMT

      type Property_Type  is 
         record
            Parcel_ID      : String (1..ID_Length);
            Purchase_Price : Price_Type;
            Assessed_Value : Value_Type;
         end record;
     
      type    City_Block_Type     is array (1..4) of Property_Type;

      subtype Tax_Bill_Type       is string (1..Total_String_Length);
      type    Tax_Bill_Array_Type is array (1..4) of Tax_Bill_Type;

      Neighborhood : City_Block_Type := 
        (("X9254", 123.0, 135.00), ("X3569", 345.0, 140.50),
         ("X3434", 234.0, 179.50), ("X8838", 456.0, 158.00));
      
      Neighborhood_Taxes : Tax_Bill_Array_Type;

      package Price_IO is new Ada.Text_IO.Decimal_IO (Price_Type);
      package Value_IO is new Ada.Text_IO.Decimal_IO (Value_Type);

   begin  -- Taxation

      Assessors_Office:
      begin

         for Parcel in City_Block_Type'Range loop
            -- Note: All data in the file will be separated with a 
            --       two-character blank spacer.
            Ada.Text_IO.Put(Tax_Roll, Neighborhood(Parcel).Parcel_ID);
            Ada.Text_IO.Put(Tax_Roll, Spacer);

            -- Use Decimal_IO.Put with non-default format parameters to
            -- place decimal data into file.
            Price_IO.Put   (Tax_Roll, Neighborhood(Parcel).Purchase_Price,
                            Fore => 3, Aft =>1, Exp => 0);
            Ada.Text_IO.Put(Tax_Roll, Spacer);

            Value_IO.Put   (Tax_Roll, Neighborhood(Parcel).Assessed_Value,
                            Fore => 3, Aft =>2, Exp => 0);
            Ada.Text_IO.New_Line(Tax_Roll);
         end loop;

         Ada.Text_IO.Close (Tax_Roll);

      exception
         when others => 
            Report.Failed ("Exception raised in Assessor's Office");
      end Assessors_Office;


      Twice_A_Year:
      declare

         procedure Collect_Tax(Index     : in     Integer;
                               Tax_Array : in out Tax_Bill_Array_Type) is
            ID            : String (1..ID_Length);
            Price         : Price_Type := 0.0; 
            Value         : Value_Type := 0.00;
            Price_String  : String (1..Price_String_Length);
            Value_String  : String (1..Value_String_Length);
         begin  

            -- Extract information from the Text_IO file; one string, two
            -- decimal values.
            -- Note that the Spacers that were put in the file above are
            -- not individually read here, due to the fact that each call
            -- to Decimal_IO.Get below uses a zero in the Width field,
            -- which allows each Get procedure to skip these leading blanks
            -- prior to extracting the numeric value.
               
            Ada.Text_IO.Get (Tax_Roll, ID);

            -- A zero value of Width is provided, so the following
            -- two calls to Decimal_IO.Get will skip the leading blanks,
            -- (from the Spacer variable above), then read the numeric
            -- literals.

            Price_IO.Get    (Tax_Roll, Price, 0);
            Value_IO.Get    (Tax_Roll, Value, 0);
            Ada.Text_IO.Skip_Line (Tax_Roll);

            -- Convert the values read from the file into string format,
            -- using user-specified format parameters.
            -- Format of the Price_String should be "nnn.n"
            -- Format of the Value_String should be "nnn.nn"

            Price_IO.Put (To   => Price_String,
                          Item => Price,
                          Aft  => 1);
            Value_IO.Put (Value_String, Value, 2);

            -- Construct a string of length 20 that contains the Parcel_ID,
            -- the Purchase_Price, and the Assessed_Value, separated by
            -- two-character blank data spacers.  Store this string
            -- into the string array out parameter.
            -- Format of each Tax_Array element should be 
            -- "Xnnnn  nnn.n  nnn.nn" (with an 'n' signifying a digit).

            Tax_Array(Index) := ID           & Spacer &
                                Price_String & Spacer &
                                Value_String;            
         exception
            when Data_Error =>
               Report.Failed("Data Error raised during the extraction " &
                             "of decimal data from the file");
            when others     => 
              Report.Failed("Exception in Collect_Tax procedure");
         end Collect_Tax;

  
      begin  -- Twice_A_Year
      
         Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.In_File, Tax_Roll_Name);

         -- Determine property tax bills for the entire neighborhood from
         -- the information that is stored in the file. Store information
         -- in the Neighborhood_Taxes string array.

         for Parcel in City_Block_Type'Range loop
            Collect_Tax (Parcel, Neighborhood_Taxes);
         end loop;

      exception
         when others => 
           Report.Failed ("Exception in Twice_A_Year Block");
      end Twice_A_Year;

      -- Use Decimal_IO Get procedure to extract information from a string.
      -- Verify data against original values.
      Validation_Block:
      declare
         TC_ID     : String (1..ID_Length);    -- 1..5
         TC_Price  : Price_Type;
         TC_Value  : Value_Type;
         Length    : Positive;
         Front,
         Rear      : Integer := 0;
      begin

         for Parcel in City_Block_Type'Range loop
            -- Extract values from the strings of the string array.
            -- Each element of the string array is 20 characters long; the
            -- first five characters are the Parcel_ID, two blank characters
            -- separate data, the next five characters contain the Price 
            -- decimal value, two blank characters separate data, the last 
            -- six characters contain the Value decimal value.  
            -- Extract each of these components in turn.

            Front := 1;                                        --  1
            Rear  := ID_Length;                                --  5
            TC_ID := Neighborhood_Taxes(Parcel)(Front..Rear);

            -- Extract the decimal value from the next slice of the string.
            Front := Rear + 3;                                 --  8
            Rear  := Front + Price_String_Length - 1;          -- 12
            Price_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
                          Item => TC_Price,
                          Last => Length);

            -- Extract next decimal value from slice of string, based on 
            -- length of preceding strings read from string array element.
            Front := Rear + 3;                                 -- 15  
            Rear  := Total_String_Length;                      -- 20
            Value_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
                          Item => TC_Value,
                          Last => Length);

            if TC_ID    /= Neighborhood(Parcel).Parcel_ID       or
               TC_Price /= Neighborhood(Parcel).Purchase_Price  or
               TC_Value /= Neighborhood(Parcel).Assessed_Value  
            then
               Report.Failed ("Incorrect data validation");
            end if;

         end loop;

      exception
         when others => Report.Failed ("Exception in Validation Block");
      end Validation_Block;

      -- Check that the Text_IO file is open, then delete.

      if not Ada.Text_IO.Is_Open (Tax_Roll) then
         Report.Failed ("File not left open after processing");
         Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
      end if;

      Ada.Text_IO.Delete (Tax_Roll);

   exception
      when others => 
         Report.Failed ("Exception in Taxation block");
         -- Check that the Text_IO file is open, then delete.
         if not Ada.Text_IO.Is_Open (Tax_Roll) then
            Ada.Text_IO.Open (Tax_Roll, 
                              Ada.Text_IO.Out_File, 
                              Tax_Roll_Name);
         end if;
         Ada.Text_IO.Delete (Tax_Roll);
   end Taxation;

   Report.Result;

exception
   when Incomplete =>
      Report.Result;
   when others     =>
      Report.Failed ( "Unexpected exception" );
      Report.Result;

end CXAA010;