annotate gcc/testsuite/ada/acats/tests/cxa/cxaa006.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- CXAA006.A
kono
parents:
diff changeset
2 --
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 --
kono
parents:
diff changeset
26 -- OBJECTIVE:
kono
parents:
diff changeset
27 -- Check that for a bounded line length text file of mode Append_File,
kono
parents:
diff changeset
28 -- when the number of characters to be output exceeds the number of
kono
parents:
diff changeset
29 -- columns remaining on the current line, a call to Put will output
kono
parents:
diff changeset
30 -- characters of the string sufficient to fill the remaining columns of
kono
parents:
diff changeset
31 -- the line (up to line length), then output a line terminator, reset the
kono
parents:
diff changeset
32 -- column number, increment the line number, then output the balance of
kono
parents:
diff changeset
33 -- the item.
kono
parents:
diff changeset
34 --
kono
parents:
diff changeset
35 -- Check that the procedure Put does not raise Layout_Error when the
kono
parents:
diff changeset
36 -- number of characters to be output exceeds the line length of a bounded
kono
parents:
diff changeset
37 -- text file of mode Append_File.
kono
parents:
diff changeset
38 --
kono
parents:
diff changeset
39 -- TEST DESCRIPTION:
kono
parents:
diff changeset
40 -- This test demonstrates the situation where an application intends to
kono
parents:
diff changeset
41 -- output variable length string elements to a text file in the most
kono
parents:
diff changeset
42 -- efficient manner possible. This is the case in a typesetting
kono
parents:
diff changeset
43 -- environment where text is compressed and split between lines of a
kono
parents:
diff changeset
44 -- bounded length.
kono
parents:
diff changeset
45 --
kono
parents:
diff changeset
46 -- The procedure Put will break string parameters placed in the file at
kono
parents:
diff changeset
47 -- the point of the line length. Two examples are demonstrated in this
kono
parents:
diff changeset
48 -- test, one being the case where only one column remains on a line, and
kono
parents:
diff changeset
49 -- the other being the case where a larger portion of the line remains
kono
parents:
diff changeset
50 -- unfilled, but still not sufficient to contain the entire output
kono
parents:
diff changeset
51 -- string.
kono
parents:
diff changeset
52 --
kono
parents:
diff changeset
53 -- During the course of the test, the file is reset to Append_File mode,
kono
parents:
diff changeset
54 -- and the bounded line length is modified for different lines of the
kono
parents:
diff changeset
55 -- file.
kono
parents:
diff changeset
56 --
kono
parents:
diff changeset
57 -- APPLICABILITY CRITERIA:
kono
parents:
diff changeset
58 -- This test is applicable to all implementations that support Text_IO
kono
parents:
diff changeset
59 -- processing and external files.
kono
parents:
diff changeset
60 --
kono
parents:
diff changeset
61 --
kono
parents:
diff changeset
62 -- CHANGE HISTORY:
kono
parents:
diff changeset
63 -- 06 Dec 94 SAIC ACVC 2.0
kono
parents:
diff changeset
64 -- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
kono
parents:
diff changeset
65 --!
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 with Ada.Text_IO;
kono
parents:
diff changeset
68 with Report;
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 procedure CXAA006 is
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 A_Bounded_File : Ada.Text_IO.File_Type;
kono
parents:
diff changeset
73 Bounded_File_Name : constant String :=
kono
parents:
diff changeset
74 Report.Legal_File_Name ( Nam => "CXAA006" );
kono
parents:
diff changeset
75 Incomplete : exception;
kono
parents:
diff changeset
76
kono
parents:
diff changeset
77 begin
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 Report.Test ("CXAA006", "Check that procedure Put will correctly " &
kono
parents:
diff changeset
80 "output string items to a bounded line " &
kono
parents:
diff changeset
81 "length text file of mode Append_File");
kono
parents:
diff changeset
82
kono
parents:
diff changeset
83 Test_for_Text_IO_Support:
kono
parents:
diff changeset
84 begin
kono
parents:
diff changeset
85
kono
parents:
diff changeset
86 -- An application creates a text file in mode Append_File, with the intention
kono
parents:
diff changeset
87 -- of using the procedure Put to compress variable length string data into the
kono
parents:
diff changeset
88 -- file in the most efficient manner possible.
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 Ada.Text_IO.Create (File => A_Bounded_File,
kono
parents:
diff changeset
91 Mode => Ada.Text_IO.Append_File,
kono
parents:
diff changeset
92 Name => Bounded_File_Name);
kono
parents:
diff changeset
93 exception
kono
parents:
diff changeset
94 when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
kono
parents:
diff changeset
95 Report.Not_Applicable
kono
parents:
diff changeset
96 ( "Files not supported - Create with Append_File for Text_IO" );
kono
parents:
diff changeset
97 raise Incomplete;
kono
parents:
diff changeset
98 end Test_For_Text_IO_Support;
kono
parents:
diff changeset
99
kono
parents:
diff changeset
100 Operational_Test_Block:
kono
parents:
diff changeset
101 declare
kono
parents:
diff changeset
102 Twelve_Characters : constant String := "12Characters";
kono
parents:
diff changeset
103 Nineteen_Characters : constant String := "Nineteen_Characters";
kono
parents:
diff changeset
104 TC_Line : Natural := 0;
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 function TC_Mode_Selection (Selector : Integer)
kono
parents:
diff changeset
107 return Ada.Text_IO.File_Mode is
kono
parents:
diff changeset
108 begin
kono
parents:
diff changeset
109 case Selector is
kono
parents:
diff changeset
110 when 1 => return Ada.Text_IO.In_File;
kono
parents:
diff changeset
111 when 2 => return Ada.Text_IO.Out_File;
kono
parents:
diff changeset
112 when others => return Ada.Text_IO.Append_File;
kono
parents:
diff changeset
113 end case;
kono
parents:
diff changeset
114 end TC_Mode_Selection;
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116 begin
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 -- The application sets the line length of the file to be bound at 20. All
kono
parents:
diff changeset
119 -- lines in this file will be limited to that length.
kono
parents:
diff changeset
120
kono
parents:
diff changeset
121 Ada.Text_IO.Set_Line_Length (A_Bounded_File, 20);
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 Ada.Text_IO.Put (A_Bounded_File, Nineteen_Characters);
kono
parents:
diff changeset
124
kono
parents:
diff changeset
125 -- Test control code.
kono
parents:
diff changeset
126 if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
kono
parents:
diff changeset
127 Report.Ident_Int(1)) or
kono
parents:
diff changeset
128 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
kono
parents:
diff changeset
129 Report.Ident_Int(20)) then
kono
parents:
diff changeset
130 Report.Failed ("Incorrect position after 1st Put");
kono
parents:
diff changeset
131 end if;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 -- The application finds that there is only one column available on the
kono
parents:
diff changeset
134 -- current line, so the next string item to be output must be broken at
kono
parents:
diff changeset
135 -- the appropriate place (following the first character).
kono
parents:
diff changeset
136
kono
parents:
diff changeset
137 Ada.Text_IO.Put (File => A_Bounded_File,
kono
parents:
diff changeset
138 Item => Twelve_Characters);
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 -- Test control code.
kono
parents:
diff changeset
141 if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
kono
parents:
diff changeset
142 Report.Ident_Int(2)) or
kono
parents:
diff changeset
143 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
kono
parents:
diff changeset
144 Report.Ident_Int(12)) then
kono
parents:
diff changeset
145 Report.Failed ("Incorrect position after 2nd Put");
kono
parents:
diff changeset
146 end if;
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148 -- The application subsequently modifies the processing, resetting the file
kono
parents:
diff changeset
149 -- at this point to In_File mode in order to verify data that has been written
kono
parents:
diff changeset
150 -- to the file. Following this, the application resets the file to Append_File
kono
parents:
diff changeset
151 -- mode in order to continue the placement of data into the file, but modifies
kono
parents:
diff changeset
152 -- the original bounded line length for subsequent lines to be appended.
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 -- Reset to Append mode; call outputs page terminator and
kono
parents:
diff changeset
155 -- resets line length to Unbounded.
kono
parents:
diff changeset
156 Reset1:
kono
parents:
diff changeset
157 begin
kono
parents:
diff changeset
158 Ada.Text_IO.Reset (A_Bounded_File,
kono
parents:
diff changeset
159 TC_Mode_Selection (Report.Ident_Int(3)));
kono
parents:
diff changeset
160 exception
kono
parents:
diff changeset
161 when Ada.Text_IO.Use_Error =>
kono
parents:
diff changeset
162 Report.Not_Applicable
kono
parents:
diff changeset
163 ( "Reset to Append_File not supported for Text_IO" );
kono
parents:
diff changeset
164 raise Incomplete;
kono
parents:
diff changeset
165 end Reset1;
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 Ada.Text_IO.Set_Line_Length (A_Bounded_File, 15);
kono
parents:
diff changeset
168
kono
parents:
diff changeset
169 -- Store line number for later comparison.
kono
parents:
diff changeset
170 TC_Line := Natural(Ada.Text_IO.Line(A_Bounded_File));
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 -- The application finds that fifteen columns are available on the current
kono
parents:
diff changeset
173 -- line but that the string item to be output exceeds this available space.
kono
parents:
diff changeset
174 -- It must be split at the end of the line, and the balance placed on the
kono
parents:
diff changeset
175 -- next file line.
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 Ada.Text_IO.Put (File => A_Bounded_File,
kono
parents:
diff changeset
178 Item => Nineteen_Characters);
kono
parents:
diff changeset
179
kono
parents:
diff changeset
180 -- Test control code.
kono
parents:
diff changeset
181 -- Positioned on new line at col 5.
kono
parents:
diff changeset
182 if (Natural(Ada.Text_IO.Line (A_Bounded_File)) /=
kono
parents:
diff changeset
183 (TC_Line + 1)) or
kono
parents:
diff changeset
184 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
kono
parents:
diff changeset
185 Report.Ident_Int(5)) then
kono
parents:
diff changeset
186 Report.Failed ("Incorrect position after 3rd Put");
kono
parents:
diff changeset
187 end if;
kono
parents:
diff changeset
188
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 Test_Verification_Block:
kono
parents:
diff changeset
191 declare
kono
parents:
diff changeset
192 First_String : String (1 .. 80);
kono
parents:
diff changeset
193 Second_String : String (1 .. 80);
kono
parents:
diff changeset
194 Third_String : String (1 .. 80);
kono
parents:
diff changeset
195 Fourth_String : String (1 .. 80);
kono
parents:
diff changeset
196 TC_Width1 : Natural;
kono
parents:
diff changeset
197 TC_Width2 : Natural;
kono
parents:
diff changeset
198 TC_Width3 : Natural;
kono
parents:
diff changeset
199 TC_Width4 : Natural;
kono
parents:
diff changeset
200 begin
kono
parents:
diff changeset
201
kono
parents:
diff changeset
202 -- The application has the capability to reset the file to In_File mode to
kono
parents:
diff changeset
203 -- verify some or all of the data that is contained there.
kono
parents:
diff changeset
204
kono
parents:
diff changeset
205 Reset2:
kono
parents:
diff changeset
206 begin
kono
parents:
diff changeset
207 Ada.Text_IO.Reset (A_Bounded_File, Ada.Text_IO.In_File);
kono
parents:
diff changeset
208 exception
kono
parents:
diff changeset
209 when others =>
kono
parents:
diff changeset
210 Report.Not_Applicable
kono
parents:
diff changeset
211 ( "Reset to In_File not supported for Text_IO" );
kono
parents:
diff changeset
212 raise Incomplete;
kono
parents:
diff changeset
213 end Reset2;
kono
parents:
diff changeset
214
kono
parents:
diff changeset
215 Ada.Text_IO.Get_Line
kono
parents:
diff changeset
216 (A_Bounded_File, First_String, TC_Width1);
kono
parents:
diff changeset
217 Ada.Text_IO.Get_Line
kono
parents:
diff changeset
218 (A_Bounded_File, Second_String, TC_Width2);
kono
parents:
diff changeset
219 Ada.Text_IO.Get_Line
kono
parents:
diff changeset
220 (A_Bounded_File, Third_String, TC_Width3);
kono
parents:
diff changeset
221 Ada.Text_IO.Get_Line
kono
parents:
diff changeset
222 (A_Bounded_File, Fourth_String, TC_Width4);
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 -- Test control code.
kono
parents:
diff changeset
225 if (First_String (1..TC_Width1) /= Nineteen_Characters & "1") or
kono
parents:
diff changeset
226 (Second_String (1..TC_Width2) /= "2Characters") or
kono
parents:
diff changeset
227 (Third_String (1..TC_Width3) /=
kono
parents:
diff changeset
228 Nineteen_Characters(1..15)) or
kono
parents:
diff changeset
229 (Fourth_String (1..TC_Width4) /= "ters")
kono
parents:
diff changeset
230 then
kono
parents:
diff changeset
231 Report.Failed ("Data placed incorrectly in file");
kono
parents:
diff changeset
232 end if;
kono
parents:
diff changeset
233
kono
parents:
diff changeset
234 exception
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 when Incomplete =>
kono
parents:
diff changeset
237 raise;
kono
parents:
diff changeset
238
kono
parents:
diff changeset
239 when Ada.Text_IO.End_Error =>
kono
parents:
diff changeset
240 Report.Failed ("Incorrect number of lines in file");
kono
parents:
diff changeset
241
kono
parents:
diff changeset
242 when others =>
kono
parents:
diff changeset
243 Report.Failed ("Error raised during data verification");
kono
parents:
diff changeset
244
kono
parents:
diff changeset
245 end Test_Verification_Block;
kono
parents:
diff changeset
246
kono
parents:
diff changeset
247 exception
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 when Ada.Text_IO.Layout_Error =>
kono
parents:
diff changeset
250 Report.Failed ("Layout Error raised when positioning text");
kono
parents:
diff changeset
251
kono
parents:
diff changeset
252 when others =>
kono
parents:
diff changeset
253 Report.Failed ("Exception in Text_IO processing");
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 end Operational_Test_Block;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 Final_Block:
kono
parents:
diff changeset
258 begin
kono
parents:
diff changeset
259 -- Delete the external file.
kono
parents:
diff changeset
260 if Ada.Text_IO.Is_Open(A_Bounded_File) then
kono
parents:
diff changeset
261 Ada.Text_IO.Delete (A_Bounded_File);
kono
parents:
diff changeset
262 else
kono
parents:
diff changeset
263 Ada.Text_IO.Open (A_Bounded_File,
kono
parents:
diff changeset
264 Ada.Text_IO.In_File,
kono
parents:
diff changeset
265 Bounded_File_Name);
kono
parents:
diff changeset
266 Ada.Text_IO.Delete (A_Bounded_File);
kono
parents:
diff changeset
267 end if;
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 exception
kono
parents:
diff changeset
270 when others =>
kono
parents:
diff changeset
271 Report.Failed
kono
parents:
diff changeset
272 ( "Delete not properly implemented for Text_IO" );
kono
parents:
diff changeset
273 end Final_Block;
kono
parents:
diff changeset
274
kono
parents:
diff changeset
275 Report.Result;
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 exception
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 when Incomplete =>
kono
parents:
diff changeset
280 Report.Result;
kono
parents:
diff changeset
281 when others =>
kono
parents:
diff changeset
282 Report.Failed ( "Unexpected exception" );
kono
parents:
diff changeset
283 Report.Result;
kono
parents:
diff changeset
284
kono
parents:
diff changeset
285 end CXAA006;