Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxaa011.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 -- CXAA011.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 operations of Text_IO.Enumeration_IO perform correctly
28 -- on files of Append_File mode, for instantiations using
29 -- enumeration types. Check that Enumeration_IO procedures Put and Get
30 -- properly transfer enumeration data to/from data files.
31 -- Check that the formatting parameters available in the package can
32 -- be used and modified successfully in the storage and retrieval of data.
33 --
34 -- TEST DESCRIPTION:
35 -- This test is designed to simulate an environment where a data file
36 -- that holds enumeration type information is reset from it current mode
37 -- to allow the appending of data to the end of the This process
38 -- of Reset/Write can be repeated as necessary. All data written
39 -- to the file is verified for accuracy when retrieved from the file.
40 --
41 -- This test verifies issues of resetting a file created in Out_File mode
42 -- to Append_File mode, resetting from Append_File mode to In_File mode,
43 -- as well as a variety of Text_IO and Enumeration_IO predefined
44 -- subprograms.
45 --
46 -- APPLICABILITY CRITERIA:
47 -- This test is applicable only to implementations that support text
48 -- files.
49 --
50 --
51 -- CHANGE HISTORY:
52 -- 06 Dec 94 SAIC ACVC 2.0
53 -- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
54 --!
55
56 with Ada.Text_IO;
57 with Report;
58
59 procedure CXAA011 is
60 use Ada;
61
62 Status_Log : Text_IO.File_Type;
63 Status_Log_Filename : constant String :=
64 Report.Legal_File_Name ( Nam => "CXAA011" );
65 Incomplete : exception;
66
67 begin
68
69 Report.Test ("CXAA011", "Check that the operations of " &
70 "Text_IO.Enumeration_IO operate correctly for " &
71 "files with mode Append_File");
72
73 Test_for_Text_IO_Support:
74 begin
75
76 -- An implementation that does not support Text_IO in a particular
77 -- environment will raise Use_Error on calls to various
78 -- Text_IO operations. This block statement encloses a call to
79 -- Create, which should raise the exception in a non-supportive
80 -- environment. This exception will be handled to produce a
81 -- Not_Applicable result.
82
83 Text_IO.Create (File => Status_Log,
84 Mode => Text_IO.Out_File,
85 Name => Status_Log_Filename);
86 exception
87
88 when Text_IO.Use_Error | Text_IO.Name_Error =>
89 Report.Not_Applicable
90 ( "Files not supported - Create as Out_File for Text_IO" );
91 raise Incomplete;
92
93 end Test_for_Text_IO_Support;
94
95
96 Operational_Test_Block:
97 declare
98
99 type Days_In_Week is (Monday, Tuesday, Wednesday, Thursday, Friday,
100 Saturday, Sunday);
101 type Hours_In_Day is (A0000, A0600, P1200, P0600); -- Six hour
102 -- blocks.
103 type Status_Type is (Operational, Off_Line);
104
105 type Status_Record_Type is record
106 Day : Days_In_Week;
107 Hour : Hours_In_Day;
108 Status : Status_Type;
109 end record;
110
111 Morning_Reading : Status_Record_Type :=
112 (Wednesday, A0600, Operational);
113 Evening_Reading : Status_Record_Type :=
114 (Saturday, P0600, Off_Line);
115
116 package Day_IO is new Text_IO.Enumeration_IO (Days_In_Week);
117 package Hours_IO is new Text_IO.Enumeration_IO (Hours_In_Day);
118 package Status_IO is new Text_IO.Enumeration_IO (Status_Type);
119
120
121 -- The following function simulates the hourly recording of equipment
122 -- status.
123
124 function Record_Status (Reading : Status_Record_Type)
125 return Boolean is
126 use Text_IO; -- To provide visibility to type Type_Set and
127 -- enumeration literal Upper_Case.
128 begin
129 Day_IO.Put (File => Status_Log,
130 Item => Reading.Day,
131 Set => Type_Set'(Upper_Case));
132 Hours_IO.Put (Status_Log, Reading.Hour, 7);
133 Status_IO.Put (Status_Log, Reading.Status,
134 Width => 8, Set => Lower_Case);
135 Text_IO.New_Line (Status_Log);
136 return (True);
137 exception
138 when others => return False;
139 end Record_Status;
140
141 begin
142
143 -- The usage scenario intended is as follows:
144 -- File is created.
145 -- Unrelated/unknown file processing occurs.
146 -- On six hour intervals, file is reset to Append_File mode.
147 -- Data is appended to file.
148 -- Unrelated/unknown file processing resumes.
149 -- Reset/Append process is repeated.
150
151 Reset1:
152 begin
153 Text_IO.Reset (Status_Log, -- Reset to
154 Text_IO.Append_File); -- Append mode.
155 exception
156 when Text_IO.Use_Error =>
157 Report.Not_Applicable
158 ( "Reset to Append_File not supported for Text_IO" );
159 raise Incomplete;
160 end Reset1;
161
162 Day_IO.Default_Width := Days_In_Week'Width + 5; -- Default values
163 -- are modifiable.
164
165 if not Record_Status (Morning_Reading) then -- Enter data.
166 Report.Failed ("Exception occurred during data file update");
167 end if;
168
169 Reset2:
170 begin
171 Text_IO.Reset (Status_Log, -- Reset to
172 Text_IO.Append_File); -- Append mode.
173 exception
174 when Text_IO.Use_Error =>
175 Report.Not_Applicable
176 ( "Reset to Append_File not supported for Text_IO" );
177 raise Incomplete;
178 end Reset2;
179
180 if not Record_Status (Evening_Reading) then -- Enter data.
181 Report.Failed ("Exception occurred during data file update");
182 end if;
183
184 Test_Verification_Block:
185 declare
186 TC_Reading1 : Status_Record_Type;
187 TC_Reading2 : Status_Record_Type;
188 begin
189
190 Reset3:
191 begin
192 Text_IO.Reset (Status_Log, Text_IO.In_File); -- Reset for
193 -- reading.
194 exception
195 when Text_IO.Use_Error =>
196 Report.Not_Applicable
197 ( "Reset to In_File not supported for Text_IO" );
198 raise Incomplete;
199 end Reset3;
200
201 Day_IO.Get (Status_Log, TC_Reading1.Day); -- Read data from
202 Hours_IO.Get (Status_Log, TC_Reading1.Hour); -- first record.
203 Status_IO.Get (Status_Log, TC_Reading1.Status);
204 Text_IO.Skip_Line (Status_Log);
205
206 -- Verify the data read from the file. Compare with the
207 -- record that was originally entered into the file.
208
209 if (TC_Reading1 /= Morning_Reading) then
210 Report.Failed ("Data error on reading first record");
211 end if;
212
213 Day_IO.Get (Status_Log, TC_Reading2.Day); -- Read data from
214 Hours_IO.Get (Status_Log, TC_Reading2.Hour); -- second record.
215 Status_IO.Get (Status_Log, TC_Reading2.Status);
216 Text_IO.Skip_Line (Status_Log);
217
218 -- Verify all of the data fields read from the file. Compare
219 -- with the values that were originally entered into the file.
220
221 if (TC_Reading2.Day /= Evening_Reading.Day) or
222 (TC_Reading2.Hour /= Evening_Reading.Hour) or
223 (TC_Reading2.Status /= Evening_Reading.Status) then
224 Report.Failed ("Data error on reading second record");
225 end if;
226
227 exception
228 when Incomplete =>
229 raise;
230 when others =>
231 Report.Failed ("Error raised during data verification");
232 end Test_Verification_Block;
233
234 exception
235 when Incomplete =>
236 raise;
237 when others =>
238 Report.Failed ("Exception in Text_IO.Enumeration_IO processing");
239 end Operational_Test_Block;
240
241 Final_Block:
242 begin
243 -- Delete the external file.
244 if Text_IO.Is_Open (Status_Log) then
245 Text_IO.Delete (Status_Log);
246 else
247 Text_IO.Open (Status_Log, Text_IO.Out_File, Status_Log_Filename);
248 Text_IO.Delete (Status_Log);
249 end if;
250 exception
251 when Text_IO.Use_Error =>
252 Report.Failed
253 ( "Delete not properly implemented for Text_IO" );
254
255 end Final_Block;
256
257 Report.Result;
258
259 exception
260 when Incomplete =>
261 Report.Result;
262 when others =>
263 Report.Failed ( "Unexpected exception" );
264 Report.Result;
265
266 end CXAA011;