Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxac005.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 -- CXAC005.A
2 --
3 -- Grant of Unlimited Rights
4 --
5 -- The Ada Conformity Assessment Authority (ACAA) holds unlimited
6 -- rights in the software and documentation contained herein. Unlimited
7 -- rights are the same as those granted by the U.S. Government for older
8 -- parts of the Ada Conformity Assessment Test Suite, and are defined
9 -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10 -- intends to confer upon all recipients unlimited rights equal to those
11 -- held by the ACAA. These rights include rights to use, duplicate,
12 -- release or disclose the released technical data and computer software
13 -- in whole or in part, in any manner and for any purpose whatsoever, and
14 -- to have or permit others 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 stream file positioning work as specified. (Defect Report
28 -- 8652/0055).
29 --
30 -- CHANGE HISTORY:
31 -- 12 FEB 2001 PHL Initial version.
32 -- 14 MAR 2001 RLB Readied for release; fixed Not_Applicable check
33 -- to terminate test gracefully.
34 --
35 --!
36 with Ada.Streams.Stream_Io;
37 use Ada.Streams;
38 with Ada.Exceptions;
39 use Ada.Exceptions;
40 with Report;
41 use Report;
42 procedure CXAC005 is
43
44 Incomplete : exception;
45
46 procedure TC_Assert (Condition : Boolean; Message : String) is
47 begin
48 if not Condition then
49 Failed (Message);
50 end if;
51 end TC_Assert;
52
53 package Checked_Stream_Io is
54
55 type File_Type (Max_Size : Stream_Element_Count) is limited private;
56 function Stream_Io_File (File : File_Type) return Stream_Io.File_Type;
57
58 procedure Create (File : in out File_Type;
59 Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
60 Name : in String := "";
61 Form : in String := "");
62
63 procedure Open (File : in out File_Type;
64 Mode : in Stream_Io.File_Mode;
65 Name : in String;
66 Form : in String := "");
67
68 procedure Close (File : in out File_Type);
69 procedure Delete (File : in out File_Type);
70
71 procedure Reset (File : in out File_Type;
72 Mode : in Stream_Io.File_Mode);
73 procedure Reset (File : in out File_Type);
74
75 procedure Read (File : in out File_Type;
76 Item : out Stream_Element_Array;
77 Last : out Stream_Element_Offset;
78 From : in Stream_Io.Positive_Count);
79
80 procedure Read (File : in out File_Type;
81 Item : out Stream_Element_Array;
82 Last : out Stream_Element_Offset);
83
84 procedure Write (File : in out File_Type;
85 Item : in Stream_Element_Array;
86 To : in Stream_Io.Positive_Count);
87
88 procedure Write (File : in out File_Type;
89 Item : in Stream_Element_Array);
90
91 procedure Set_Index (File : in out File_Type;
92 To : in Stream_Io.Positive_Count);
93
94 function Index (File : in File_Type) return Stream_Io.Positive_Count;
95
96 procedure Set_Mode (File : in out File_Type;
97 Mode : in Stream_Io.File_Mode);
98
99 private
100 type File_Type (Max_Size : Stream_Element_Count) is
101 record
102 File : Stream_Io.File_Type;
103 Index : Stream_Io.Positive_Count;
104 Contents :
105 Stream_Element_Array
106 (Stream_Element_Offset (Ident_Int (1)) .. Max_Size);
107 end record;
108 end Checked_Stream_Io;
109
110 package body Checked_Stream_Io is
111
112 use Stream_Io;
113
114 function Stream_Io_File (File : File_Type) return Stream_Io.File_Type is
115 begin
116 return File.File;
117 end Stream_Io_File;
118
119 procedure Create (File : in out File_Type;
120 Mode : in Stream_Io.File_Mode := Stream_Io.Out_File;
121 Name : in String := "";
122 Form : in String := "") is
123 begin
124 Stream_Io.Create (File.File, Mode, Name, Form);
125 File.Index := Stream_Io.Index (File.File);
126 if Mode = Append_File then
127 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
128 "Index /= Size + 1 -- Create - Append_File");
129 else
130 TC_Assert (File.Index = 1, "Index /= 1 -- Create - " &
131 File_Mode'Image (Mode));
132 end if;
133 end Create;
134
135 procedure Open (File : in out File_Type;
136 Mode : in Stream_Io.File_Mode;
137 Name : in String;
138 Form : in String := "") is
139 begin
140 Stream_Io.Open (File.File, Mode, Name, Form);
141 File.Index := Stream_Io.Index (File.File);
142 if Mode = Append_File then
143 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
144 "Index /= Size + 1 -- Open - Append_File");
145 else
146 TC_Assert (File.Index = 1, "Index /= 1 -- Open - " &
147 File_Mode'Image (Mode));
148 end if;
149 end Open;
150
151 procedure Close (File : in out File_Type) is
152 begin
153 Stream_Io.Close (File.File);
154 end Close;
155
156 procedure Delete (File : in out File_Type) is
157 begin
158 Stream_Io.Delete (File.File);
159 end Delete;
160
161 procedure Reset (File : in out File_Type;
162 Mode : in Stream_Io.File_Mode) is
163 begin
164 Stream_Io.Reset (File.File, Mode);
165 File.Index := Stream_Io.Index (File.File);
166 if Mode = Append_File then
167 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
168 "Index /= Size + 1 -- Reset - Append_File");
169 else
170 TC_Assert (File.Index = 1, "Index /= 1 -- Reset - " &
171 File_Mode'Image (Mode));
172 end if;
173 end Reset;
174
175 procedure Reset (File : in out File_Type) is
176 begin
177 Reset (File, Stream_Io.Mode (File.File));
178 end Reset;
179
180
181 procedure Read (File : in out File_Type;
182 Item : out Stream_Element_Array;
183 Last : out Stream_Element_Offset;
184 From : in Stream_Io.Positive_Count) is
185 begin
186 Set_Index (File, From);
187 Read (File, Item, Last);
188 end Read;
189
190 procedure Read (File : in out File_Type;
191 Item : out Stream_Element_Array;
192 Last : out Stream_Element_Offset) is
193 Index : constant Stream_Element_Offset :=
194 Stream_Element_Offset (File.Index);
195 begin
196 Stream_Io.Read (File.File, Item, Last);
197 if Last < Item'Last then
198 TC_Assert (Item (Item'First .. Last) =
199 File.Contents (Index .. Index + Last - Item'First),
200 "Incorrect data read from file - 1");
201 TC_Assert (Count (Index + Last - Item'First) =
202 Stream_Io.Size (File.File),
203 "Read stopped before end of file");
204 File.Index := Count (Index + Last - Item'First) + 1;
205 else
206 TC_Assert (Item = File.Contents (Index .. Index + Item'Length - 1),
207 "Incorrect data read from file - 2");
208 File.Index := File.Index + Item'Length;
209 end if;
210 end Read;
211
212 procedure Write (File : in out File_Type;
213 Item : in Stream_Element_Array;
214 To : in Stream_Io.Positive_Count) is
215 begin
216 Set_Index (File, To);
217 Write (File, Item);
218 end Write;
219
220 procedure Write (File : in out File_Type;
221 Item : in Stream_Element_Array) is
222 Index : constant Stream_Element_Offset :=
223 Stream_Element_Offset (File.Index);
224 begin
225 Stream_Io.Write (File.File, Item);
226 File.Contents (Index .. Index + Item'Length - 1) := Item;
227 File.Index := File.Index + Item'Length;
228 TC_Assert (File.Index = Stream_Io.Index (File.File),
229 "Write failed to move the index");
230 end Write;
231
232 procedure Set_Index (File : in out File_Type;
233 To : in Stream_Io.Positive_Count) is
234 begin
235 Stream_Io.Set_Index (File.File, To);
236 File.Index := Stream_Io.Index (File.File);
237 TC_Assert (File.Index = To, "Set_Index failed");
238 end Set_Index;
239
240 function Index (File : in File_Type) return Stream_Io.Positive_Count is
241 New_Index : constant Count := Stream_Io.Index (File.File);
242 begin
243 TC_Assert (New_Index = File.Index, "Index changed unexpectedly");
244 return New_Index;
245 end Index;
246
247 procedure Set_Mode (File : in out File_Type;
248 Mode : in Stream_Io.File_Mode) is
249 Old_Index : constant Count := File.Index;
250 begin
251 Stream_Io.Set_Mode (File.File, Mode);
252 File.Index := Stream_Io.Index (File.File);
253 if Mode = Append_File then
254 TC_Assert (File.Index = Stream_Io.Size (File.File) + 1,
255 "Index /= Size + 1 -- Set_Mode - Append_File");
256 else
257 TC_Assert (File.Index = Old_Index, "Set_Mode changed the index");
258 end if;
259 end Set_Mode;
260
261 end Checked_Stream_Io;
262
263 package Csio renames Checked_Stream_Io;
264
265 F : Csio.File_Type (100);
266 S : Stream_Element_Array (1 .. 10);
267 Last : Stream_Element_Offset;
268
269 begin
270
271 Test ("CXAC005", "Check that stream file positioning work as specified");
272
273 declare
274 Name : constant String := Legal_File_Name;
275 begin
276 begin
277 Csio.Create (F, Name => Name);
278 exception
279 when others =>
280 Not_Applicable ("Files not supported - Creation with Out_File for Stream_IO");
281 raise Incomplete;
282 end;
283
284 for I in Stream_Element range 1 .. 10 loop
285 Csio.Write (F, ((1 => I + 2)));
286 end loop;
287 Csio.Write (F, (1 .. 15 => 11));
288 Csio.Write (F, (1 .. 15 => 12), To => 15);
289
290 Csio.Reset (F);
291
292 for I in Stream_Element range 1 .. 10 loop
293 Csio.Write (F, (1 => I));
294 end loop;
295 Csio.Write (F, (1 .. 15 => 13));
296 Csio.Write (F, (1 .. 15 => 14), To => 15);
297 Csio.Write (F, (1 => 90));
298
299 Csio.Set_Mode (F, Stream_Io.In_File);
300
301 Csio.Read (F, S, Last);
302 Csio.Read (F, S, Last, From => 3);
303 Csio.Read (F, S, Last, From => 28);
304
305 Csio.Set_Mode (F, Stream_Io.Append_File);
306 Csio.Write (F, (1 .. 5 => 88));
307
308 Csio.Close (F);
309
310 Csio.Open (F, Name => Name, Mode => Stream_Io.Append_File);
311 Csio.Write (F, (1 .. 3 => 33));
312
313 Csio.Set_Mode (F, Stream_Io.In_File);
314 Csio.Read (F, S, Last, From => 20);
315 Csio.Read (F, S, Last);
316 Csio.Reset (F, Stream_Io.Out_File);
317
318 Csio.Write (F, (1 .. 9 => 99));
319
320 -- Check the contents of the entire file.
321 declare
322 S : Stream_Element_Array
323 (1 .. Stream_Element_Offset
324 (Stream_Io.Size (Csio.Stream_Io_File (F))));
325 begin
326 Csio.Reset (F, Stream_Io.In_File);
327 Csio.Read (F, S, Last);
328 end;
329
330 Csio.Delete (F);
331 end;
332
333 Result;
334 exception
335 when Incomplete =>
336 Report.Result;
337 when E:others =>
338 Report.Failed ("Unexpected exception raised - " & Exception_Name (E) &
339 " - " & Exception_Message (E));
340 Report.Result;
341
342 end CXAC005;
343