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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxa9001.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXA9001.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 operations defined in the generic package
28
--      Ada.Storage_IO provide the ability to store and retrieve objects
29
--      which may include implicit levels of indirection in their
30
--      implementation, from an in-memory buffer.
31
--
32
-- TEST DESCRIPTION:
33
--      The following scenario demonstrates how an object of a type with
34
--      (potential) levels of indirection (based on the implementation)
35
--      can be "flattened" and written/read to/from a Direct_IO file.
36
--      In this small example, we have attempted to simulate the situation
37
--      where two independent programs are using a particular Direct_IO file,
38
--      one writing data to the file, and the second program reading that file.
39
--      The Storage_IO Read and Write procedures are used to "flatten"
40
--      and reconstruct objects of the record type.
41
--
42
-- APPLICABILITY CRITERIA:
43
--      Applicable to implementations capable of supporting external
44
--      Direct_IO files.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--      07 Jun 95   SAIC    Modified to constrain type used with Storage_IO.
50
--      20 Nov 95   SAIC    Corrected and enhanced for ACVC 2.0.1.
51
--      25 Feb 97   PWB.CTA Allowed for non-support of some IO operations
52
--!
53
 
54
with Report;
55
with Ada.Storage_IO;
56
with Ada.Direct_IO;
57
 
58
procedure CXA9001 is
59
   package Dir_IO is new Ada.Direct_IO (Integer);
60
   Test_File  : Dir_IO.File_Type;
61
   Incomplete : exception;
62
begin
63
 
64
   Report.Test ("CXA9001", "Check that the operations defined in the "      &
65
                           "generic package Ada.Storage_IO provide the "    &
66
                           "ability to store and retrieve objects which "   &
67
                           "may include implicit levels of indirection in " &
68
                           "their implementation, from an in-memory buffer");
69
 
70
 
71
   Test_For_Direct_IO_Support:
72
   begin
73
 
74
      -- The following Create does not have any bearing on the test scenario,
75
      -- but is included to check that the implementation supports Direct_IO
76
      -- files.  An exception on this Create statement will raise a Name_Error
77
      -- or Use_Error, which will be handled to produce a Not_Applicable
78
      -- result. If created, the file is immediately deleted, as it is not
79
      -- needed for the program scenario.
80
 
81
      Dir_IO.Create (Test_File, Dir_IO.Out_File, Report.Legal_File_Name(1));
82
 
83
   exception
84
 
85
       when Dir_IO.Use_Error | Dir_IO.Name_Error =>
86
          Report.Not_Applicable
87
             ( "Files not supported - Create as Out_File for Direct_IO" );
88
          raise Incomplete;
89
 
90
   end Test_for_Direct_IO_Support;
91
 
92
   Deletion1:
93
   begin
94
      Dir_IO.Delete (Test_File);
95
   exception
96
      when others =>
97
         Report.Failed
98
            ( "Delete not properly implemented for Direct_IO - 1" );
99
   end Deletion1;
100
 
101
 
102
   Test_Block:
103
   declare
104
 
105
      The_Filename : constant String := Report.Legal_File_Name(2);
106
 
107
      -- The following type is the basic unit used in this test. It is
108
      -- incorporated into the definition of the Unit_Array_Type.
109
 
110
      type Unit_Type is
111
         record
112
            Position     : Natural := 19;
113
            String_Value : String (1..9) := (others => 'X');
114
         end record;
115
 
116
      TC_Size : Natural := Natural'First;
117
 
118
      procedure Data_Storage (Number_Of_Units  : in     Natural;
119
                              Result           :    out Natural) is
120
 
121
         -- Type based on input parameter.  Uses type Unit_Type
122
         -- as the array element.
123
         type Unit_Array_Type is array (1..Number_Of_Units)
124
           of Unit_Type;
125
 
126
         -- This type definition is the ultimate storage type used
127
         -- in this test; uses type Unit_Array_Type as a record
128
         -- component field.
129
         -- This record type contains a component that is an array of
130
         -- records, with each of these records containing a Natural
131
         -- and a String value (i.e., a record containing an array of
132
         -- records).
133
 
134
         type Data_Storage_Type is
135
            record
136
               Data_Value : Natural := Number_Of_Units;
137
               Unit_Array : Unit_Array_Type;
138
            end record;
139
 
140
         -- The instantiation of the following generic package is a
141
         -- central point in this test.  Storage_IO is instantiated for
142
         -- a specific data type, and will be used to "flatten" objects
143
         -- of that type into buffers.  Direct_IO is instantiated for
144
         -- these Storage_IO buffers.
145
 
146
         package Flat_Storage_IO is
147
           new Ada.Storage_IO (Data_Storage_Type);
148
         package Buffer_IO is
149
           new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
150
 
151
         Buffer_File      : Buffer_IO.File_Type;
152
         Outbound_Buffer  : Flat_Storage_IO.Buffer_Type;
153
         Storage_Item     : Data_Storage_Type;
154
 
155
      begin  -- procedure Data_Storage
156
 
157
         Buffer_IO.Create (Buffer_File,
158
                           Buffer_IO.Out_File,
159
                           The_Filename);
160
 
161
         Flat_Storage_IO.Write (Buffer => Outbound_Buffer,
162
                                Item   => Storage_Item);
163
 
164
         -- At this point, any levels of indirection have been removed
165
         -- by the Storage_IO procedure, and the buffered data can be
166
         -- written to a file.
167
 
168
         Buffer_IO.Write (Buffer_File, Outbound_Buffer);
169
         Buffer_IO.Close (Buffer_File);
170
         Result := Storage_Item.Unit_Array'Last +           -- 5 +
171
                   Storage_Item.Unit_Array                  -- 9
172
                     (Storage_Item.Unit_Array'First).String_Value'Length;
173
 
174
      exception
175
         when others =>
176
            Report.Failed ("Data storage error");
177
            if Buffer_IO.Is_Open (Buffer_File) then
178
               Buffer_IO.Close (Buffer_File);
179
            end if;
180
      end Data_Storage;
181
 
182
      procedure Data_Retrieval (Number_Of_Units  : in     Natural;
183
                                Result           :    out Natural) is
184
         type Unit_Array_Type is array (1..Number_Of_Units)
185
           of Unit_Type;
186
 
187
         type Data_Storage_Type is
188
            record
189
               Data_Value : Natural := Number_Of_Units;
190
               Unit_Array : Unit_Array_Type;
191
            end record;
192
 
193
         package Flat_Storage_IO is
194
           new Ada.Storage_IO (Data_Storage_Type);
195
         package Reader_IO is
196
           new Ada.Direct_IO (Flat_Storage_IO.Buffer_Type);
197
 
198
         Reader_File      : Reader_IO.File_Type;
199
         Inbound_Buffer   : Flat_Storage_IO.Buffer_Type;
200
         Storage_Item     : Data_Storage_Type;
201
         TC_Item          : Data_Storage_Type;
202
 
203
      begin  -- procedure Data_Retrieval
204
 
205
         Reader_IO.Open (Reader_File, Reader_IO.In_File, The_Filename);
206
         Reader_IO.Read (Reader_File, Inbound_Buffer);
207
 
208
         Flat_Storage_IO.Read (Inbound_Buffer, Storage_Item);
209
 
210
         -- Validate the reconstructed value against an "unflattened"
211
         -- value.
212
 
213
         if Storage_Item.Data_Value /= TC_Item.Data_Value
214
         then
215
            Report.Failed ("Data_Retrieval Error - 1");
216
         end if;
217
 
218
         for i in 1..Number_Of_Units loop
219
            if Storage_Item.Unit_Array(i).String_Value'Length  /=
220
               TC_Item.Unit_Array(i).String_Value'Length      or
221
               Storage_Item.Unit_Array(i).Position     /=
222
               TC_Item.Unit_Array(i).Position             or
223
               Storage_Item.Unit_Array(i).String_Value /=
224
               TC_Item.Unit_Array(i).String_Value
225
            then
226
               Report.Failed ("Data_Retrieval Error - 2");
227
            end if;
228
         end loop;
229
 
230
         Result := Storage_Item.Unit_Array'Last +           -- 5 +
231
                   Storage_Item.Unit_Array                  -- 9
232
                     (Storage_Item.Unit_Array'First).String_Value'Length;
233
 
234
         if Reader_IO.Is_Open (Reader_File) then
235
            Reader_IO.Delete (Reader_File);
236
         else
237
            Reader_IO.Open (Reader_File,
238
                            Reader_IO.In_File,
239
                            The_Filename);
240
            Reader_IO.Delete (Reader_File);
241
         end if;
242
 
243
      exception
244
         when others =>
245
            Report.Failed ("Exception raised in Data_Retrieval");
246
            if Reader_IO.Is_Open (Reader_File) then
247
               Reader_IO.Delete (Reader_File);
248
            else
249
               Reader_IO.Open (Reader_File,
250
                               Reader_IO.In_File,
251
                               The_Filename);
252
               Reader_IO.Delete (Reader_File);
253
            end if;
254
      end Data_Retrieval;
255
 
256
 
257
   begin  -- Test_Block
258
 
259
      -- The number of Units is provided in this call to Data_Storage.
260
      Data_Storage (Number_Of_Units  => Natural(Report.Ident_Int(5)),
261
                    Result           => TC_Size);
262
 
263
      if TC_Size /= 14 then
264
         Report.Failed ("Data_Storage error in Data_Storage");
265
      end if;
266
 
267
      Data_Retrieval (Number_Of_Units  => Natural(Report.Ident_Int(5)),
268
                      Result           => TC_Size);
269
 
270
      if TC_Size /= 14 then
271
         Report.Failed ("Data retrieval error in Data_Retrieval");
272
      end if;
273
 
274
   exception
275
      when others => Report.Failed ("Exception raised in Test_Block");
276
   end Test_Block;
277
 
278
   Report.Result;
279
 
280
exception
281
   when Incomplete =>
282
      Report.Result;
283
   when others     =>
284
      Report.Failed ( "Unexpected exception" );
285
      Report.Result;
286
 
287
end CXA9001;

powered by: WebSVN 2.1.0

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