Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxa8002.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- CXA8002.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 resetting a file using mode Append_File allows for the
28 -- writing of elements to the file starting after the last element in
29 -- the file.
30 -- Check that the result of function Name can be used on a subsequent
31 -- reopen of the file.
32 -- Check that a mode change occurs on reset of a file to/from mode
33 -- Append_File.
34 --
35 -- TEST DESCRIPTION:
36 -- This test simulates the read/write of data from/to an individual
37 -- sequential file. New data can be appended to the end of the existing
38 -- file, and the same file can be reset to allow reading of data from
39 -- the file. This process can occur multiple times.
40 -- When the mode of the file is changed with a Reset, the current mode
41 -- value assigned to the file is checked using the result of function
42 -- Mode. This, in conjunction with the read/write operations, verifies
43 -- that a mode change has taken place on Reset.
44 --
45 -- An expected common usage of the scenarios found in this test would
46 -- be a case where a single data file is kept open continuously, being
47 -- reset for read/append of data. For systems that do not support a
48 -- direct form of I/O, this would allow for efficient use of a sequential
49 -- I/O file.
50 --
51 -- APPLICABILITY CRITERIA:
52 -- Applicable to all systems capable of supporting IO operations on
53 -- external Sequential_IO files.
54 --
55 --
56 -- CHANGE HISTORY:
57 -- 06 Dec 94 SAIC ACVC 2.0
58 -- 19 Feb 97 PWB.CTA Fixed handling for file non-support and Reset
59 -- non-support.
60 --!
61
62 with Sequential_IO;
63 with Report;
64
65 procedure CXA8002 is
66 subtype Employee_Data is String (1 .. 11);
67 package Data_IO is new Sequential_IO (Employee_Data);
68
69 Employee_Data_File : Data_IO.File_Type;
70 Employee_Filename : constant String :=
71 Report.Legal_File_Name (Nam => "CXA8002");
72
73 Incomplete : exception;
74
75 begin
76
77 Report.Test ("CXA8002", "Check that resetting a file using mode " &
78 "Append_File allows for the writing of " &
79 "elements to the file starting after the " &
80 "last element in the file");
81
82 Test_for_Sequential_IO_Support:
83 begin
84
85 -- An implementation that does not support Sequential_IO in a particular
86 -- environment will raise Use_Error or Name_Error on calls to various
87 -- Sequential_IO operations. This block statement encloses a call to
88 -- Create, which should produce an exception in a non-supportive
89 -- environment. These exceptions will be handled to produce a
90 -- Not_Applicable result.
91
92 Data_IO.Create (File => Employee_Data_File, -- Create file in
93 Mode => Data_IO.Append_File, -- mode Append_File.
94 Name => Employee_Filename);
95
96 --
97 -- The following portion of code demonstrates the fact that a sequential
98 -- file can be created in Append_File mode, and that data can be written
99 -- to the file.
100 --
101
102 exception
103 when Data_IO.Use_Error | Data_IO.Name_Error =>
104 Report.Not_Applicable
105 ( "Sequential files not supported - Create as Append_File");
106 raise Incomplete;
107 end Test_for_Sequential_IO_Support;
108 Operational_Test_Block:
109 declare
110 Blank_Data : constant Employee_Data := " ";
111 Employee_1 : constant Employee_Data := "123-45-6789";
112 Employee_2 : Employee_Data := "987-65-4321";
113
114 -- Note: Artificial numerical data chosen above to prevent any
115 -- unintended similarity with persons alive or dead.
116
117 TC_Employee_Data : Employee_Data := Blank_Data;
118
119
120 function TC_Mode_Selection (Selector : Integer)
121 return Data_IO.File_Mode is
122 begin
123 case Report.Ident_Int(Selector) is
124 when 1 => return Data_IO.In_File;
125 when 2 => return Data_IO.Out_File;
126 when others => return Data_IO.Append_File;
127 end case;
128 end TC_Mode_Selection;
129
130 Employee_Filename : constant String := -- Use function Name to
131 Data_IO.Name (File => Employee_Data_File); -- store filename in
132 -- string variable.
133 begin
134
135 Data_IO.Write (File => Employee_Data_File, -- Write initial data
136 Item => Employee_1); -- entry to file.
137
138 --
139 -- The following portion of code demonstrates that a sequential file
140 -- can be reset to various file modes, including Append_File mode,
141 -- allowing data to be added to the end of the file.
142 --
143 begin
144 Data_IO.Reset (File => Employee_Data_File, -- Reset file with
145 Mode => Data_IO.In_File); -- mode In_File.
146 exception
147 when Data_IO.Use_Error =>
148 Report.Not_Applicable
149 ("Reset to In_File not supported for Sequential_IO");
150 raise Incomplete;
151 when others =>
152 Report.Failed
153 ("Unexpected exception on Reset to In_File (Sequential_IO)");
154 raise Incomplete;
155 end;
156 if Data_IO."="(Data_IO.Mode (Employee_Data_File),
157 TC_Mode_Selection (1)) then -- Compare In_File mode
158 -- Reset successful,
159 Data_IO.Read (File => Employee_Data_File, -- now verify file data.
160 Item => TC_Employee_Data);
161
162 if ((TC_Employee_Data (1 .. 7) /= "123-45-") or
163 (TC_Employee_Data (5 .. 11) /= "45-6789")) then
164 Report.Failed ("Data read error");
165 end if;
166
167 else
168 Report.Failed ("File mode not changed by Reset");
169 end if;
170
171 --
172 -- Simulate appending data to a file that has previously been written
173 -- to and read from.
174 --
175 begin
176 Data_IO.Reset (File => Employee_Data_File, -- Reset file with
177 Mode => Data_IO.Append_File); -- mode Append_File.
178 exception
179 when Data_IO.Use_Error =>
180 Report.Not_Applicable
181 ("Reset to Append_File not supported for Sequential_IO");
182 raise Incomplete;
183 when others =>
184 Report.Failed
185 ("Unexpected exception on Reset to Append_File (Sequential_IO)");
186 raise Incomplete;
187 end;
188
189 if Data_IO.Is_Open (Employee_Data_File) then -- File remains open
190 -- following Reset to
191 -- Append_File mode?
192
193 if Data_IO."=" (Data_IO.Mode (Employee_Data_File),
194 TC_Mode_Selection (3)) then -- Compare to
195 -- Append_File mode.
196 Data_IO.Write (File => Employee_Data_File, -- Write additional
197 Item => Employee_2); -- data to file.
198 else
199 Report.Failed ("File mode not changed by Reset");
200 end if;
201
202 else
203 Report.Failed
204 ("File status not Open following Reset to Append mode");
205 end if;
206
207 Data_IO.Close (Employee_Data_File);
208
209
210 Test_Verification_Block:
211 begin
212
213 Data_IO.Open (File => Employee_Data_File, -- Reopen file, using
214 Mode => Data_IO.In_File, -- previous result of
215 Name => Employee_Filename); -- function Name.
216
217 TC_Employee_Data := Blank_Data; -- Clear record field.
218 Data_IO.Read (Employee_Data_File, -- Read first record,
219 TC_Employee_Data); -- check ordering of
220 -- records.
221
222 if not ((TC_Employee_Data (1 .. 3) = "123") and then
223 (TC_Employee_Data (4 .. 11) = "-45-6789")) then
224 Report.Failed ("Data read error - first record");
225 end if;
226
227 TC_Employee_Data := Blank_Data; -- Clear record field.
228 Data_IO.Read (Employee_Data_File, -- Read second record,
229 TC_Employee_Data); -- check for ordering of
230 -- records.
231
232 if ((TC_Employee_Data (1 .. 6) /= "987-65") or else
233 not (TC_Employee_Data (3 .. 11) = "7-65-4321")) then
234 Report.Failed ("Data read error - second record");
235 end if;
236
237 -- Check that only two items were written to the file.
238 if not Data_IO.End_Of_File(Employee_Data_File) then
239 Report.Failed("Incorrect number of records in file");
240 end if;
241
242 exception
243
244 when Data_IO.End_Error => -- If two items not in
245 -- file (data overwritten),
246 -- then fail.
247 Report.Failed ("Incorrect number of record elements in file");
248
249 when others =>
250 Report.Failed ("Error raised during data verification");
251
252 end Test_Verification_Block;
253
254 exception
255
256 when others =>
257 Report.Failed("Exception raised during Sequential_IO processing");
258
259 end Operational_Test_Block;
260
261 Final_Block:
262 begin
263 -- Check that file is open prior to deleting it.
264 if Data_IO.Is_Open(Employee_Data_File) then
265 Data_IO.Delete (Employee_Data_File);
266 else
267 Data_IO.Open(Employee_Data_File,
268 Data_IO.In_File,
269 Employee_Filename);
270 Data_IO.Delete (Employee_Data_File);
271 end if;
272 exception
273 when others =>
274 Report.Failed ("Sequential_IO Delete not properly supported");
275 end Final_Block;
276
277 Report.Result;
278
279 exception
280 when Incomplete =>
281 Report.Result;
282 when others =>
283 Report.Failed ("Unexpected exception");
284 Report.Result;
285 end CXA8002;