Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxaa006.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 -- CXAA006.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 for a bounded line length text file of mode Append_File,
28 -- when the number of characters to be output exceeds the number of
29 -- columns remaining on the current line, a call to Put will output
30 -- characters of the string sufficient to fill the remaining columns of
31 -- the line (up to line length), then output a line terminator, reset the
32 -- column number, increment the line number, then output the balance of
33 -- the item.
34 --
35 -- Check that the procedure Put does not raise Layout_Error when the
36 -- number of characters to be output exceeds the line length of a bounded
37 -- text file of mode Append_File.
38 --
39 -- TEST DESCRIPTION:
40 -- This test demonstrates the situation where an application intends to
41 -- output variable length string elements to a text file in the most
42 -- efficient manner possible. This is the case in a typesetting
43 -- environment where text is compressed and split between lines of a
44 -- bounded length.
45 --
46 -- The procedure Put will break string parameters placed in the file at
47 -- the point of the line length. Two examples are demonstrated in this
48 -- test, one being the case where only one column remains on a line, and
49 -- the other being the case where a larger portion of the line remains
50 -- unfilled, but still not sufficient to contain the entire output
51 -- string.
52 --
53 -- During the course of the test, the file is reset to Append_File mode,
54 -- and the bounded line length is modified for different lines of the
55 -- file.
56 --
57 -- APPLICABILITY CRITERIA:
58 -- This test is applicable to all implementations that support Text_IO
59 -- processing and external files.
60 --
61 --
62 -- CHANGE HISTORY:
63 -- 06 Dec 94 SAIC ACVC 2.0
64 -- 25 Feb 97 PWB.CTA Allowed for non-support of some IO operations
65 --!
66
67 with Ada.Text_IO;
68 with Report;
69
70 procedure CXAA006 is
71
72 A_Bounded_File : Ada.Text_IO.File_Type;
73 Bounded_File_Name : constant String :=
74 Report.Legal_File_Name ( Nam => "CXAA006" );
75 Incomplete : exception;
76
77 begin
78
79 Report.Test ("CXAA006", "Check that procedure Put will correctly " &
80 "output string items to a bounded line " &
81 "length text file of mode Append_File");
82
83 Test_for_Text_IO_Support:
84 begin
85
86 -- An application creates a text file in mode Append_File, with the intention
87 -- of using the procedure Put to compress variable length string data into the
88 -- file in the most efficient manner possible.
89
90 Ada.Text_IO.Create (File => A_Bounded_File,
91 Mode => Ada.Text_IO.Append_File,
92 Name => Bounded_File_Name);
93 exception
94 when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
95 Report.Not_Applicable
96 ( "Files not supported - Create with Append_File for Text_IO" );
97 raise Incomplete;
98 end Test_For_Text_IO_Support;
99
100 Operational_Test_Block:
101 declare
102 Twelve_Characters : constant String := "12Characters";
103 Nineteen_Characters : constant String := "Nineteen_Characters";
104 TC_Line : Natural := 0;
105
106 function TC_Mode_Selection (Selector : Integer)
107 return Ada.Text_IO.File_Mode is
108 begin
109 case Selector is
110 when 1 => return Ada.Text_IO.In_File;
111 when 2 => return Ada.Text_IO.Out_File;
112 when others => return Ada.Text_IO.Append_File;
113 end case;
114 end TC_Mode_Selection;
115
116 begin
117
118 -- The application sets the line length of the file to be bound at 20. All
119 -- lines in this file will be limited to that length.
120
121 Ada.Text_IO.Set_Line_Length (A_Bounded_File, 20);
122
123 Ada.Text_IO.Put (A_Bounded_File, Nineteen_Characters);
124
125 -- Test control code.
126 if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
127 Report.Ident_Int(1)) or
128 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
129 Report.Ident_Int(20)) then
130 Report.Failed ("Incorrect position after 1st Put");
131 end if;
132
133 -- The application finds that there is only one column available on the
134 -- current line, so the next string item to be output must be broken at
135 -- the appropriate place (following the first character).
136
137 Ada.Text_IO.Put (File => A_Bounded_File,
138 Item => Twelve_Characters);
139
140 -- Test control code.
141 if (Integer(Ada.Text_IO.Line (A_Bounded_File)) /=
142 Report.Ident_Int(2)) or
143 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
144 Report.Ident_Int(12)) then
145 Report.Failed ("Incorrect position after 2nd Put");
146 end if;
147
148 -- The application subsequently modifies the processing, resetting the file
149 -- at this point to In_File mode in order to verify data that has been written
150 -- to the file. Following this, the application resets the file to Append_File
151 -- mode in order to continue the placement of data into the file, but modifies
152 -- the original bounded line length for subsequent lines to be appended.
153
154 -- Reset to Append mode; call outputs page terminator and
155 -- resets line length to Unbounded.
156 Reset1:
157 begin
158 Ada.Text_IO.Reset (A_Bounded_File,
159 TC_Mode_Selection (Report.Ident_Int(3)));
160 exception
161 when Ada.Text_IO.Use_Error =>
162 Report.Not_Applicable
163 ( "Reset to Append_File not supported for Text_IO" );
164 raise Incomplete;
165 end Reset1;
166
167 Ada.Text_IO.Set_Line_Length (A_Bounded_File, 15);
168
169 -- Store line number for later comparison.
170 TC_Line := Natural(Ada.Text_IO.Line(A_Bounded_File));
171
172 -- The application finds that fifteen columns are available on the current
173 -- line but that the string item to be output exceeds this available space.
174 -- It must be split at the end of the line, and the balance placed on the
175 -- next file line.
176
177 Ada.Text_IO.Put (File => A_Bounded_File,
178 Item => Nineteen_Characters);
179
180 -- Test control code.
181 -- Positioned on new line at col 5.
182 if (Natural(Ada.Text_IO.Line (A_Bounded_File)) /=
183 (TC_Line + 1)) or
184 (Integer(Ada.Text_IO.Col (A_Bounded_File)) /=
185 Report.Ident_Int(5)) then
186 Report.Failed ("Incorrect position after 3rd Put");
187 end if;
188
189
190 Test_Verification_Block:
191 declare
192 First_String : String (1 .. 80);
193 Second_String : String (1 .. 80);
194 Third_String : String (1 .. 80);
195 Fourth_String : String (1 .. 80);
196 TC_Width1 : Natural;
197 TC_Width2 : Natural;
198 TC_Width3 : Natural;
199 TC_Width4 : Natural;
200 begin
201
202 -- The application has the capability to reset the file to In_File mode to
203 -- verify some or all of the data that is contained there.
204
205 Reset2:
206 begin
207 Ada.Text_IO.Reset (A_Bounded_File, Ada.Text_IO.In_File);
208 exception
209 when others =>
210 Report.Not_Applicable
211 ( "Reset to In_File not supported for Text_IO" );
212 raise Incomplete;
213 end Reset2;
214
215 Ada.Text_IO.Get_Line
216 (A_Bounded_File, First_String, TC_Width1);
217 Ada.Text_IO.Get_Line
218 (A_Bounded_File, Second_String, TC_Width2);
219 Ada.Text_IO.Get_Line
220 (A_Bounded_File, Third_String, TC_Width3);
221 Ada.Text_IO.Get_Line
222 (A_Bounded_File, Fourth_String, TC_Width4);
223
224 -- Test control code.
225 if (First_String (1..TC_Width1) /= Nineteen_Characters & "1") or
226 (Second_String (1..TC_Width2) /= "2Characters") or
227 (Third_String (1..TC_Width3) /=
228 Nineteen_Characters(1..15)) or
229 (Fourth_String (1..TC_Width4) /= "ters")
230 then
231 Report.Failed ("Data placed incorrectly in file");
232 end if;
233
234 exception
235
236 when Incomplete =>
237 raise;
238
239 when Ada.Text_IO.End_Error =>
240 Report.Failed ("Incorrect number of lines in file");
241
242 when others =>
243 Report.Failed ("Error raised during data verification");
244
245 end Test_Verification_Block;
246
247 exception
248
249 when Ada.Text_IO.Layout_Error =>
250 Report.Failed ("Layout Error raised when positioning text");
251
252 when others =>
253 Report.Failed ("Exception in Text_IO processing");
254
255 end Operational_Test_Block;
256
257 Final_Block:
258 begin
259 -- Delete the external file.
260 if Ada.Text_IO.Is_Open(A_Bounded_File) then
261 Ada.Text_IO.Delete (A_Bounded_File);
262 else
263 Ada.Text_IO.Open (A_Bounded_File,
264 Ada.Text_IO.In_File,
265 Bounded_File_Name);
266 Ada.Text_IO.Delete (A_Bounded_File);
267 end if;
268
269 exception
270 when others =>
271 Report.Failed
272 ( "Delete not properly implemented for Text_IO" );
273 end Final_Block;
274
275 Report.Result;
276
277 exception
278
279 when Incomplete =>
280 Report.Result;
281 when others =>
282 Report.Failed ( "Unexpected exception" );
283 Report.Result;
284
285 end CXAA006;