1-- CXAA018.A
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- OBJECTIVE:
27--      Check that the subprograms defined in the package Text_IO.Modular_IO
28--      provide correct results.
29--
30-- TEST DESCRIPTION:
31--      This test checks that the subprograms defined in the
32--      Ada.Text_IO.Modular_IO package provide correct results.
33--      A modular type is defined and used to instantiate the generic
34--      package Ada.Text_IO.Modular_IO.  Values of the modular type are
35--      written to a Text_IO file, and to a series of string variables, using
36--      different versions of the procedure Put from the instantiated IO
37--      package.  These modular data items are retrieved from the file and
38--      string variables using the appropriate instantiated version of
39--      procedure Get.  A variety of Base and Width parameter values are
40--      used in the procedure calls.
41--
42-- APPLICABILITY CRITERIA:
43--      This test is applicable to all implementations that support Text_IO
44--      processing and external files.
45--
46--
47-- CHANGE HISTORY:
48--      03 Jul 95   SAIC    Initial prerelease version.
49--      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
50--
51--!
52
53with Ada.Text_IO;
54with System;
55with Report;
56
57procedure CXAA018 is
58begin
59
60   Report.Test ("CXAA018", "Check that the subprograms defined in "  &
61                           "the package Text_IO.Modular_IO provide " &
62                           "correct results");
63
64   Test_for_Text_IO_Support:
65   declare
66      Data_File     : Ada.Text_IO.File_Type;
67      Data_Filename : constant String := Report.Legal_File_Name;
68   begin
69
70      -- An application creates a text file in mode Out_File, with the
71      -- intention of entering modular data into the file as appropriate.
72      -- In the event that the particular environment where the application
73      -- is running does not support Text_IO, Use_Error or Name_Error will be
74      -- raised on calls to Text_IO operations.  Either of these exceptions
75      -- will be handled to produce a Not_Applicable result.
76
77      Ada.Text_IO.Create (File => Data_File,
78                          Mode => Ada.Text_IO.Out_File,
79                          Name => Data_Filename);
80
81      Test_Block:
82      declare
83
84         type Mod_Type is mod System.Max_Binary_Modulus;
85         -- Max_Binary_Modulus must be at least 2**16, which would result
86         -- in a base range of 0..65535 (zero to one less than the given
87         -- modulus) for this modular type.
88
89         package Mod_IO is new Ada.Text_IO.Modular_IO(Mod_Type);
90         use Ada.Text_IO, Mod_IO;
91         use type Mod_Type;
92
93         Number_Of_Modular_Items : constant := 6;
94         Number_Of_Error_Items   : constant := 1;
95
96         TC_Modular              : Mod_Type;
97         TC_Last_Character_Read  : Positive;
98
99         Modular_Array : array (1..Number_Of_Modular_Items) of Mod_Type :=
100                                   ( 0, 97, 255, 1025, 12097, 65535 );
101
102
103         procedure Load_File (The_File : in out Ada.Text_IO.File_Type) is
104         begin
105            -- This procedure does not create, open, or close the data file;
106            -- The_File file object must be Open at this point.
107            -- This procedure is designed to load Modular_Type data into a
108            -- data file.
109            --
110            -- Use the Modular_IO procedure Put to enter modular data items
111            -- into the data file.
112
113            for i in 1..Number_Of_Modular_Items loop
114               -- Use default Base parameter of 10.
115               Mod_IO.Put(File  => Data_File,
116                          Item  => Modular_Array(i),
117                          Width => 6,
118                          Base  => Mod_IO.Default_Base);
119            end loop;
120
121            -- Enter data into the file such that on the corresponding "Get"
122            -- of this data, Data_Error must be raised.  This value is outside
123            -- the base range of Modular_Type.
124            -- Text_IO is used to enter the value in the file.
125
126            for i in 1..Number_Of_Error_Items loop
127               Ada.Text_IO.Put(The_File, "-10");
128            end loop;
129
130         end Load_File;
131
132
133
134         procedure Process_File(The_File : in out Ada.Text_IO.File_Type) is
135         begin
136            -- This procedure does not create, open, or close the data file;
137            -- The_File file object must be Open at this point.
138            -- Use procedure Get (for Files) to extract the modular data from
139            -- the Text_IO file.
140
141            for i in 1..Number_Of_Modular_Items loop
142               Mod_IO.Get(The_File, TC_Modular, Width => 6);
143
144               if TC_Modular /= Modular_Array(i) then
145                  Report.Failed("Incorrect modular data read from file " &
146                                "data item #" & Integer'Image(i));
147               end if;
148            end loop;
149
150            -- The final item in the Data_File is a modular value that is
151            -- outside the base range 0..Num'Last.  This value should raise
152            -- Data_Error on an attempt to "Get" it from the file.
153
154            for i in 1..Number_Of_Error_Items loop
155               begin
156                  Mod_IO.Get(The_File, TC_Modular, Mod_IO.Default_Width);
157                  Report.Failed
158                    ("Exception Data_Error not raised when Get "   &
159                     "was used to read modular data outside base " &
160                     "range of type, item # "                      &
161                     Integer'Image(i));
162               exception
163                  when Ada.Text_IO.Data_Error =>
164                     null; -- OK, expected exception.
165                  when others =>
166                     Report.Failed("Unexpected exception raised when Get "  &
167                                   "was used to read modular data outside " &
168                                   "base range of type from Data_File, "    &
169                                   "data item #" & Integer'Image(i));
170               end;
171            end loop;
172
173         exception
174            when others =>
175              Report.Failed
176                ("Unexpected exception raised in Process_File");
177         end Process_File;
178
179
180
181      begin  -- Test_Block.
182
183         -- Place modular values into data file.
184
185         Load_File(Data_File);
186         Ada.Text_IO.Close(Data_File);
187
188         -- Read modular values from data file.
189
190         Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
191         Process_File(Data_File);
192
193         -- Verify versions of Modular_IO procedures Put and Get for Strings.
194
195         Modular_IO_in_Strings:
196         declare
197            TC_String_Array : array (1..Number_Of_Modular_Items)
198                              of String(1..30) := (others =>(others => ' '));
199         begin
200
201            -- Place modular values into strings using the Procedure Put,
202            -- Use a variety of different "Base" parameter values.
203            -- Note: This version of Put uses the length of the given
204            --       string as the value of the "Width" parameter.
205
206            for i in 1..2 loop
207               Mod_IO.Put(To   => TC_String_Array(i),
208                          Item => Modular_Array(i),
209                          Base => Mod_IO.Default_Base);
210            end loop;
211            for i in 3..4 loop
212               Mod_IO.Put(TC_String_Array(i),
213                          Modular_Array(i),
214                          Base => 2);
215            end loop;
216            for i in 5..6 loop
217               Mod_IO.Put(TC_String_Array(i), Modular_Array(i), 16);
218            end loop;
219
220            -- Get modular values from strings using the Procedure Get.
221            -- Compare with expected modular values.
222
223            for i in 1..Number_Of_Modular_Items loop
224
225               Mod_IO.Get(From => TC_String_Array(i),
226                          Item => TC_Modular,
227                          Last => TC_Last_Character_Read);
228
229               if TC_Modular /= Modular_Array(i) then
230                  Report.Failed("Incorrect modular data value obtained "   &
231                                "from String following use of Procedures " &
232                                "Put and Get from Strings, Modular_Array " &
233                                "item #" & Integer'Image(i));
234               end if;
235            end loop;
236
237         exception
238            when others =>
239               Report.Failed("Unexpected exception raised during the " &
240                             "evaluation of Put and Get for Strings");
241         end Modular_IO_in_Strings;
242
243      exception
244         when others => Report.Failed ("Exception raised in Test_Block");
245      end Test_Block;
246
247
248      -- Delete the external file.
249      if Ada.Text_IO.Is_Open(Data_File) then
250         Ada.Text_IO.Delete(Data_File);
251      else
252         Ada.Text_IO.Open(Data_File,
253                          Ada.Text_IO.In_File,
254                          Data_Filename);
255         Ada.Text_IO.Delete(Data_File);
256      end if;
257
258   exception
259
260      -- Since Use_Error can be raised if, for the specified mode,
261      -- the environment does not support Text_IO operations, the
262      -- following handlers are included:
263
264      when Ada.Text_IO.Use_Error  =>
265         Report.Not_Applicable ("Use_Error raised on Text_IO Create");
266
267      when Ada.Text_IO.Name_Error =>
268         Report.Not_Applicable ("Name_Error raised on Text_IO Create");
269
270      when others                 =>
271         Report.Failed ("Unexpected exception raised on text file Create");
272
273   end Test_for_Text_IO_Support;
274
275   Report.Result;
276
277end CXAA018;
278