Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxaa003.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 -- CXAA003.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 procedures New_Page, Set_Line, Set_Col, and New_Line
28 -- subprograms perform properly on a text file reset (from Out_File)
29 -- with mode Append_File.
30 -- Check that the attributes Page, Line, and Column are all set to 1
31 -- following the reset of a text file with mode Append_File.
32 -- Check that the functions Page, Line, and Col perform properly on a
33 -- text file reset with mode Append_File.
34 -- Check that the procedures Put and Put_Line perform properly on text
35 -- files reset with mode Append_File.
36 -- Check that the procedure Set_Line sets the current line number to
37 -- the value specified by the parameter "To" for text files reset with
38 -- mode Append_File. Check that Set_Line has no effect if the specified
39 -- line equals the current line.
40 -- Check that the procedure Set_Col sets the current column number to
41 -- the value specified by the parameter "To" for text files reset with
42 -- mode Append_File.
43 --
44 -- TEST DESCRIPTION:
45 -- This test is designed to simulate the text processing that could
46 -- occur with files that have been created in Out_File mode,
47 -- and then reset to Append_File mode.
48 -- Various calls to Text_IO formatting subprograms are called to properly
49 -- position text appended to a document. The text content and position
50 -- are subsequently verified for accuracy.
51 --
52 -- APPLICABILITY CRITERIA:
53 -- This test is applicable only to implementations that support text
54 -- files.
55 --
56 --
57 -- CHANGE HISTORY:
58 -- 06 Dec 94 SAIC ACVC 2.0
59 -- 24 Feb 97 PWB.CTA Allowed for non-support of some IO operations.
60 --!
61
62 with Ada.Text_IO;
63 with Report;
64
65 procedure CXAA003 is
66 use Ada;
67 Data_File : Text_IO.File_Type;
68 Data_Filename : constant String :=
69 Report.Legal_File_Name ( Nam => "CXAA003" );
70 Incomplete : exception;
71
72 begin
73
74 Report.Test ("CXAA003", "Check that page, line, and column formatting " &
75 "subprograms perform properly on text files " &
76 "reset with mode Append_File");
77
78 Test_for_Text_IO_Support:
79 begin
80
81 -- An implementation that does not support Text_IO in a particular
82 -- environment will raise Use_Error on calls to various
83 -- Text_IO operations. This block statement encloses a call to
84 -- Create, which should raise the exception in a non-supportive
85 -- environment. This exception will be handled to produce a
86 -- Not_Applicable result.
87
88 Text_IO.Create (File => Data_File,
89 Mode => Text_IO.Out_File,
90 Name => Data_Filename);
91 exception
92 when Text_IO.Use_Error | Text_IO.Name_Error =>
93 Report.Not_Applicable
94 ( "Text files not supported - Create as Out_File" );
95 raise Incomplete;
96 end Test_for_Text_IO_Support;
97
98 Operational_Test_Block:
99 declare
100
101 Default_Position : constant Text_IO.Positive_Count := 1;
102
103 Section_Header : constant String := "IX. ";
104 Glossary_Title : constant String := "GLOSSARY";
105 Glossary_Content : constant String := "TBD";
106
107 -- The following procedure simulates the addition of a Glossary page
108 -- to an existing text file that has been reset with mode
109 -- Append_File.
110
111 procedure Position_Glossary_Text
112 (The_File : in out Text_IO.File_Type) is
113 use Text_IO; -- To provide visibility to the "/=" operator.
114 begin
115
116 -- Test control code.
117 -- Verify initial page value.
118 if (Text_IO.Page (The_File) /= Default_Position) then
119 Report.Failed ("Incorrect default page number");
120 end if;
121 -- Verify initial line number.
122 if (Text_IO.Line (The_File) /= Default_Position) then
123 Report.Failed ("Incorrect default line number");
124 end if;
125 -- Verify initial column number.
126 if (Text_IO.Col (The_File) /= Default_Position) then
127 Report.Failed ("Incorrect default column number");
128 end if;
129 -- Simulated usage code. Set new page/line positions.
130 Text_IO.New_Page (The_File);
131 Text_IO.New_Page (The_File);
132 Text_IO.New_Line (File => The_File, Spacing => 1);
133
134 -- Test control code.
135 if (Integer(Text_IO.Page(The_File)) /=
136 Report.Ident_Int(3)) or else
137 (Integer(Text_IO.Line (The_File)) /=
138 Report.Ident_Int(2)) then
139 Report.Failed ("Incorrect results from page/line positioning");
140 end if;
141
142 -- Simulated usage code. Position title of Glossary.
143 Text_IO.Put (The_File, Section_Header);
144 Text_IO.Put_Line (The_File, Glossary_Title);
145 -- Set line to the current line.
146 Text_IO.Set_Line (File => The_File, To => 3);
147
148 -- Test control code.
149 if (Integer(Text_IO.Page (The_File)) /= Report.Ident_Int(3)) or
150 (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(3)) or
151 (Integer(Text_IO.Col (The_File)) /= Report.Ident_Int(1)) then
152 Report.Failed ("Set_Line failed for current line");
153 end if;
154
155 -- Simulated usage code.
156 Text_IO.Set_Line (File => The_File, To => 4); -- Set new
157 Text_IO.Set_Col (File => The_File, To => 10); -- position.
158
159 -- Test control code.
160 if (Integer(Text_IO.Line (The_File)) /= Report.Ident_Int(4)) or
161 (Integer(Text_IO.Col (The_File)) /= Report.Ident_Int(10)) then
162 Report.Failed
163 ("Incorrect results from line/column positioning");
164 end if;
165
166 -- Simulated usage code. -- Position
167 Text_IO.Put_Line (The_File, Glossary_Content); -- content of
168 -- Glossary.
169 end Position_Glossary_Text;
170
171
172 begin
173
174 -- In the scenario, data is added to the file here.
175 Text_IO.Put_Line (File => Data_File, Item => "Some optional data");
176
177 -- This code section simulates a scenario that could occur in a
178 -- text processing environment. Text is to be appended to an
179 -- existing document:
180 -- The file is reset to append mode.
181 -- A procedure is called to perform the positioning and placement
182 -- of text.
183 -- The position on the appended page is set, verified, and text is
184 -- placed in the file.
185 --
186 -- Note: The text file has been originally created in Out_File
187 -- mode, and has subsequently been reset to Append_File mode.
188
189 Reset1:
190 begin
191 -- Reset has effect of calling New_Page.
192 Text_IO.Reset (Data_File, Text_IO.Append_File);
193 exception
194 when Text_IO.Use_Error =>
195 Report.Not_Applicable
196 ( "Reset to Append_File not supported for Text_IO" );
197 raise Incomplete;
198 end Reset1;
199
200 Position_Glossary_Text (The_File => Data_File);
201
202 Test_Verification_Block:
203 declare
204 TC_Page, TC_Line, TC_Column : Text_IO.Positive_Count;
205 TC_Position : Natural := 0;
206 Blanks : constant String :=
207 " ";
208 TC_String : String (1 .. 15) := Blanks;
209 begin
210 Reset2:
211 begin
212 Text_IO.Reset (Data_File, Text_IO.In_File);
213 exception
214 when Text_IO.Use_Error =>
215 Report.Not_Applicable
216 ( "Reset to In_File not supported for Text_IO" );
217 raise Incomplete;
218 end Reset2;
219
220 Text_IO.Skip_Page (Data_File);
221 Text_IO.Skip_Page (Data_File);
222
223 -- If the Reset to Append_File mode actually put a page terminator
224 -- on the file, as allowed (but not required) by RM A.10.2(4), then
225 -- we are now on page 3, an empty page. We'll need to skip one more.
226
227 if Text_IO.End_Of_Page (Data_File) then
228 Text_IO.Skip_Page (Data_File);
229 end if;
230
231 -- Now we're on the Glossary page.
232
233 -- Loop to the second line
234 for I in 1 .. 2 loop -- and read the contents.
235 Text_IO.Get_Line (Data_File, TC_String, TC_Position);
236 end loop;
237 if (TC_Position /= 13) or else -- Verify the title line.
238 (TC_String (1..2) /= "IX") or else
239 (TC_String (3..13) /= (". " & Glossary_Title)) then
240 Report.Failed ("Incorrect positioning of title line");
241 end if;
242
243 TC_String := Blanks; -- Clear string.
244 -- Loop to the fourth line
245 for I in 3 .. 4 loop -- and read the contents.
246 Text_IO.Get_Line (Data_File, TC_String, TC_Position);
247 end loop;
248
249 if (TC_Position /= 12) or -- Verify the contents.
250 (TC_String (8..12) /= " " & Glossary_Content) then
251 Report.Failed ("Incorrect positioning of contents line");
252 end if;
253
254 exception
255 when Incomplete =>
256 raise;
257 when others =>
258 Report.Failed ("Error raised during data verification");
259
260 end Test_Verification_Block;
261
262 exception
263 when Incomplete =>
264 raise;
265 when others =>
266 Report.Failed ("Exception raised during Text_IO processing");
267
268 end Operational_Test_Block;
269
270 Final_Block:
271 begin
272 -- Delete the external file.
273 if Text_IO.Is_Open (Data_File) then
274 Text_IO.Delete (Data_File);
275 else
276 Text_IO.Open (Data_File, Text_IO.In_File, Data_Filename);
277 Text_IO.Delete (Data_File);
278 end if;
279 exception
280 when others =>
281 Report.Failed ( "Delete not properly implemented for Text_IO" );
282 end Final_Block;
283
284 Report.Result;
285
286 exception
287 when Incomplete =>
288 Report.Result;
289 when others =>
290 Report.Failed ( "Unexpected exception" );
291 Report.Result;
292
293 end CXAA003;