OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxac005.a] - Blame information for rev 316

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.