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/] [cxa9002.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXA9002.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
--      of tagged types from in-memory buffers.
30
--
31
-- TEST DESCRIPTION:
32
--      The following scenario demonstrates how objects of a tagged type,
33
--      extended types, and twice extended types can be written/read
34
--      to/from Direct_IO files. The Storage_IO subprograms, Read and Write,
35
--      demonstrated in this scenario, perform tag "fixing" prior to/following
36
--      transfer to the Direct_IO files.
37
--      This method is especially important for those implementations that
38
--      represent tags as pointers, or for cases where the tagged objects
39
--      are read in by a program other than the one that wrote them.
40
--
41
--      In this small example, we have attempted to simulate the situation
42
--      where two independent programs are using a series of Direct_IO files,
43
--      one writing data to the files, and the second program reading the
44
--      data from those files.  Two procedures are defined, the first
45
--      simulating the program responsible for writing, the second simulating
46
--      a separate program opening and reading the data from the files.
47
--
48
--      The hierarchy of types used in this test can be displayed as follows:
49
--
50
--                                Account_Type
51
--                                 /       \
52
--                                /         \
53
--                               /           \
54
--                  Cash_Account_Type       Investment_Account_Type
55
--                     /         \
56
--                    /           \
57
--                   /             \
58
--      Checking_Account_Type    Savings_Account_Type
59
--
60
-- APPLICABILITY CRITERIA:
61
--      Applicable to implementations capable of supporting external
62
--      Direct_IO files.
63
--
64
--
65
-- CHANGE HISTORY:
66
--      06 Dec 94   SAIC    ACVC 2.0
67
--      08 Nov 95   SAIC    Corrected incorrect prefix of 'Tag for ACVC 2.0.1,
68
--                          and mode of files in Procedure Read_Data.
69
--                          Added verification of objects reconstructed from
70
--                          files.
71
--      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
72
--!
73
 
74
package CXA9002_0 is
75
 
76
   type Investment_Type is (Stocks, Bonds, Mutual_Funds);
77
   type Savings_Type    is (Standard, Business, Impound);
78
 
79
   type Account_Type is tagged
80
      record
81
         Num : String (1..3);
82
      end record;
83
 
84
   type Cash_Account_Type is new Account_Type with
85
      record
86
         Years_As_Customer : Natural := 1;
87
      end record;
88
 
89
   type Investment_Account_Type is new Account_Type with
90
      record
91
         Investment_Vehicle : Investment_Type := Stocks;
92
      end record;
93
 
94
   type Checking_Account_Type is new Cash_Account_Type with
95
      record
96
         Checks_Per_Year  : Positive := 200;
97
         Interest_Bearing : Boolean  := False;
98
      end record;
99
 
100
   type Savings_Account_Type is new Cash_Account_Type with
101
      record
102
         Kind : Savings_Type := Standard;
103
      end record;
104
 
105
end CXA9002_0;
106
 
107
---
108
 
109
with Report;
110
with Ada.Storage_IO;
111
with Ada.Direct_IO;
112
with Ada.Tags;
113
with CXA9002_0;
114
 
115
procedure CXA9002 is
116
   package Dir_IO is new Ada.Direct_IO (Integer);
117
   Test_File : Dir_IO.File_Type;
118
   Incomplete : exception;
119
begin
120
 
121
   Report.Test ("CXA9002", "Check that the operations defined in the "   &
122
                           "generic package Ada.Storage_IO provide the " &
123
                           "ability to store and retrieve objects of "   &
124
                           "tagged types from in-memory buffers");
125
 
126
 
127
   Test_For_Direct_IO_Support:
128
   begin
129
 
130
      -- The following Create does not have any bearing on the test scenario,
131
      -- but is included to check that the implementation supports Direct_IO
132
      -- files.  An exception on this Create statement will raise a Name_Error
133
      -- or Use_Error, which will be handled to produce a Not_Applicable
134
      -- result. If created, the file is immediately deleted, as it is not
135
      -- needed for the program scenario.
136
 
137
      Dir_IO.Create (Test_File,
138
                     Dir_IO.Out_File,
139
                     Report.Legal_File_Name(1));
140
   exception
141
 
142
       when Dir_IO.Use_Error | Dir_IO.Name_Error =>
143
          Report.Not_Applicable
144
             ( "Files not supported - Create as Out_File for Direct_IO" );
145
          raise Incomplete;
146
 
147
   end Test_for_Direct_IO_Support;
148
 
149
   Deletion:
150
   begin
151
      Dir_IO.Delete (Test_File);
152
   exception
153
      when others =>
154
         Report.Failed
155
            ( "Delete not properly implemented for Direct_IO" );
156
   end Deletion;
157
 
158
   Test_Block:
159
   declare
160
 
161
      use CXA9002_0;
162
 
163
      Acct_Filename : constant String := Report.Legal_File_Name(1);
164
      Cash_Filename : constant String := Report.Legal_File_Name(2);
165
      Inv_Filename  : constant String := Report.Legal_File_Name(3);
166
      Chk_Filename  : constant String := Report.Legal_File_Name(4);
167
      Sav_Filename  : constant String := Report.Legal_File_Name(5);
168
 
169
      type Tag_Pointer_Type is access String;
170
 
171
      TC_Account_Type_Tag,
172
      TC_Cash_Account_Type_Tag,
173
      TC_Investment_Account_Type_Tag,
174
      TC_Checking_Account_Type_Tag,
175
      TC_Savings_Account_Type_Tag    : Tag_Pointer_Type;
176
 
177
      TC_Account            : Account_Type            :=
178
                                (Num => "123");
179
 
180
      TC_Cash_Account       : Cash_Account_Type       :=
181
                                (Num               => "234",
182
                                 Years_As_Customer => 3);
183
 
184
      TC_Investment_Account : Investment_Account_Type :=
185
                                (Num                => "456",
186
                                 Investment_Vehicle => Bonds);
187
 
188
      TC_Checking_Account   : Checking_Account_Type   :=
189
                                (Num               => "567",
190
                                 Years_As_Customer => 2,
191
                                 Checks_Per_Year   => 300,
192
                                 Interest_Bearing  => True);
193
 
194
      TC_Savings_Account    : Savings_Account_Type    :=
195
                                (Num               => "789",
196
                                 Years_As_Customer => 14,
197
                                 Kind              => Business);
198
 
199
      procedure Buffer_Data is
200
 
201
         Account            : Account_Type            :=
202
                                TC_Account;
203
         Cash_Account       : Cash_Account_Type       :=
204
                                TC_Cash_Account;
205
         Investment_Account : Investment_Account_Type :=
206
                                TC_Investment_Account;
207
         Checking_Account   : Checking_Account_Type   :=
208
                                TC_Checking_Account;
209
         Savings_Account    : Savings_Account_Type    :=
210
                                TC_Savings_Account;
211
 
212
         -- The instantiations below are a central point in this test.
213
         -- Storage_IO is instantiated for each of the specific tagged
214
         -- type. These instantiated packages will be used to compress
215
         -- tagged objects of these various types into buffers that will
216
         -- be written to the Direct_IO files declared below.
217
 
218
         package Acct_SIO is new Ada.Storage_IO (Account_Type);
219
         package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
220
         package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
221
         package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
222
         package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
223
 
224
         -- Direct_IO is instantiated for the buffer types defined in the
225
         -- instantiated Storage_IO packages.
226
 
227
         package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
228
         package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
229
         package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
230
         package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
231
         package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
232
 
233
         Acct_Buffer : Acct_SIO.Buffer_Type;
234
         Cash_Buffer : Cash_SIO.Buffer_Type;
235
         Inv_Buffer  : Inv_SIO.Buffer_Type;
236
         Chk_Buffer  : Chk_SIO.Buffer_Type;
237
         Sav_Buffer  : Sav_SIO.Buffer_Type;
238
 
239
         Acct_File   : Acct_DIO.File_Type;
240
         Cash_File   : Cash_DIO.File_Type;
241
         Inv_File    : Inv_DIO.File_Type;
242
         Chk_File    : Chk_DIO.File_Type;
243
         Sav_File    : Sav_DIO.File_Type;
244
 
245
      begin
246
 
247
         Acct_DIO.Create (Acct_File, Acct_DIO.Out_File, Acct_Filename);
248
         Cash_DIO.Create (Cash_File, Cash_DIO.Out_File, Cash_Filename);
249
         Inv_DIO.Create  (Inv_File,  Inv_DIO.Out_File,  Inv_Filename);
250
         Chk_DIO.Create  (Chk_File,  Chk_DIO.Out_File,  Chk_Filename);
251
         Sav_DIO.Create  (Sav_File,  Sav_DIO.Out_File,  Sav_Filename);
252
 
253
         -- Store the tag values of the objects declared above for
254
         -- comparison with tag values of objects following processing.
255
 
256
         TC_Account_Type_Tag :=
257
           new String'(Ada.Tags.External_Tag(Account_Type'Tag));
258
 
259
         TC_Cash_Account_Type_Tag :=
260
           new String'(Ada.Tags.External_Tag(Cash_Account_Type'Tag));
261
 
262
         TC_Investment_Account_Type_Tag :=
263
           new String'(Ada.Tags.External_Tag(Investment_Account_Type'Tag));
264
 
265
         TC_Checking_Account_Type_Tag :=
266
           new String'(Ada.Tags.External_Tag(Checking_Account_Type'Tag));
267
 
268
         TC_Savings_Account_Type_Tag :=
269
           new String'(Ada.Tags.External_Tag(Savings_Account_Type'Tag));
270
 
271
         -- Prepare tagged data for writing to the Direct_IO files using
272
         -- Storage_IO procedure to place data in buffers.
273
 
274
         Acct_SIO.Write (Buffer => Acct_Buffer, Item => Account);
275
         Cash_SIO.Write (Cash_Buffer, Cash_Account);
276
         Inv_SIO.Write  (Inv_Buffer, Item => Investment_Account);
277
         Chk_SIO.Write  (Buffer => Chk_Buffer, Item => Checking_Account);
278
         Sav_SIO.Write  (Sav_Buffer, Savings_Account);
279
 
280
         -- At this point, the data and associated tag values have been
281
         -- buffered by the Storage_IO procedure, and the buffered data
282
         -- can be written to the appropriate Direct_IO file.
283
 
284
         Acct_DIO.Write (File => Acct_File, Item => Acct_Buffer);
285
         Cash_DIO.Write (Cash_File, Cash_Buffer);
286
         Inv_DIO.Write  (Inv_File, Item => Inv_Buffer);
287
         Chk_DIO.Write  (File => Chk_File, Item =>Chk_Buffer);
288
         Sav_DIO.Write  (Sav_File, Sav_Buffer);
289
 
290
         -- Close all Direct_IO files.
291
 
292
         Acct_DIO.Close (Acct_File);
293
         Cash_DIO.Close (Cash_File);
294
         Inv_DIO.Close  (Inv_File);
295
         Chk_DIO.Close  (Chk_File);
296
         Sav_DIO.Close  (Sav_File);
297
 
298
      exception
299
         when others => Report.Failed("Exception raised in Buffer_Data");
300
      end Buffer_Data;
301
 
302
      procedure Read_Data is
303
 
304
         Account            : Account_Type;
305
         Cash_Account       : Cash_Account_Type;
306
         Investment_Account : Investment_Account_Type;
307
         Checking_Account   : Checking_Account_Type;
308
         Savings_Account    : Savings_Account_Type;
309
 
310
         -- Storage_IO is instantiated for each of the specific tagged
311
         -- type.
312
 
313
         package Acct_SIO is new Ada.Storage_IO (Account_Type);
314
         package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
315
         package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
316
         package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
317
         package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
318
 
319
         -- Direct_IO is instantiated for the buffer types defined in the
320
         -- instantiated Storage_IO packages.
321
 
322
         package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
323
         package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
324
         package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
325
         package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
326
         package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
327
 
328
         Acct_Buffer : Acct_SIO.Buffer_Type;
329
         Cash_Buffer : Cash_SIO.Buffer_Type;
330
         Inv_Buffer  : Inv_SIO.Buffer_Type;
331
         Chk_Buffer  : Chk_SIO.Buffer_Type;
332
         Sav_Buffer  : Sav_SIO.Buffer_Type;
333
 
334
         Acct_File   : Acct_DIO.File_Type;
335
         Cash_File   : Cash_DIO.File_Type;
336
         Inv_File    : Inv_DIO.File_Type;
337
         Chk_File    : Chk_DIO.File_Type;
338
         Sav_File    : Sav_DIO.File_Type;
339
 
340
      begin
341
 
342
         -- Open the Direct_IO files.
343
 
344
         Acct_DIO.Open (Acct_File, Acct_DIO.In_File, Acct_Filename);
345
         Cash_DIO.Open (Cash_File, Cash_DIO.In_File, Cash_Filename);
346
         Inv_DIO.Open  (Inv_File,  Inv_DIO.In_File,  Inv_Filename);
347
         Chk_DIO.Open  (Chk_File,  Chk_DIO.In_File,  Chk_Filename);
348
         Sav_DIO.Open  (Sav_File,  Sav_DIO.In_File,  Sav_Filename);
349
 
350
         -- Read the buffer data from the files using Direct_IO.
351
 
352
         Acct_DIO.Read (File => Acct_File, Item => Acct_Buffer);
353
         Cash_DIO.Read (Cash_File, Cash_Buffer);
354
         Inv_DIO.Read  (Inv_File, Item => Inv_Buffer);
355
         Chk_DIO.Read  (File => Chk_File, Item =>Chk_Buffer);
356
         Sav_DIO.Read  (Sav_File, Sav_Buffer);
357
 
358
         -- At this point, the data and associated tag values are stored
359
         -- in buffers. Use the Storage_IO procedure Read to recreate the
360
         -- tagged objects from the buffers.
361
 
362
         Acct_SIO.Read (Buffer => Acct_Buffer, Item => Account);
363
         Cash_SIO.Read (Cash_Buffer, Cash_Account);
364
         Inv_SIO.Read  (Inv_Buffer, Item => Investment_Account);
365
         Chk_SIO.Read  (Buffer => Chk_Buffer, Item => Checking_Account);
366
         Sav_SIO.Read  (Sav_Buffer, Savings_Account);
367
 
368
         -- Delete all Direct_IO files.
369
 
370
         Acct_DIO.Delete (Acct_File);
371
         Cash_DIO.Delete (Cash_File);
372
         Inv_DIO.Delete  (Inv_File);
373
         Chk_DIO.Delete  (Chk_File);
374
         Sav_DIO.Delete  (Sav_File);
375
 
376
         Data_Verification_Block:
377
         begin
378
 
379
            if Account /= TC_Account then
380
               Report.Failed("Incorrect Account object reconstructed");
381
            end if;
382
 
383
            if Cash_Account /= TC_Cash_Account then
384
               Report.Failed
385
                 ("Incorrect Cash_Account object reconstructed");
386
            end if;
387
 
388
            if Investment_Account /= TC_Investment_Account then
389
               Report.Failed
390
                 ("Incorrect Investment_Account object reconstructed");
391
            end if;
392
 
393
            if Checking_Account /= TC_Checking_Account then
394
               Report.Failed
395
                 ("Incorrect Checking_Account object reconstructed");
396
            end if;
397
 
398
            if Savings_Account /= TC_Savings_Account then
399
               Report.Failed
400
                 ("Incorrect Savings_Account object reconstructed");
401
            end if;
402
 
403
         exception
404
            when others =>
405
              Report.Failed
406
                ("Exception raised during Data_Verification Block");
407
         end Data_Verification_Block;
408
 
409
 
410
         -- To ensure that the tags of the values reconstructed by
411
         -- Storage_IO were properly preserved, object tag values following
412
         -- object reconstruction are compared with tag values of objects
413
         -- stored prior to processing.
414
 
415
         Tag_Verification_Block:
416
         begin
417
 
418
            if TC_Account_Type_Tag.all /=
419
               Ada.Tags.External_Tag(Account_Type'Class(Account)'Tag)
420
            then
421
               Report.Failed("Incorrect Account tag");
422
            end if;
423
 
424
            if TC_Cash_Account_Type_Tag.all       /=
425
               Ada.Tags.External_Tag(
426
                 Cash_Account_Type'Class(Cash_Account)'Tag)
427
            then
428
               Report.Failed("Incorrect Cash_Account tag");
429
            end if;
430
 
431
            if TC_Investment_Account_Type_Tag.all /=
432
               Ada.Tags.External_Tag(
433
                 Investment_Account_Type'Class(Investment_Account)'Tag)
434
            then
435
               Report.Failed("Incorrect Investment_Account tag");
436
            end if;
437
 
438
            if TC_Checking_Account_Type_Tag.all   /=
439
               Ada.Tags.External_Tag(
440
                 Checking_Account_Type'Class(Checking_Account)'Tag)
441
            then
442
               Report.Failed("Incorrect Checking_Account tag");
443
            end if;
444
 
445
            if TC_Savings_Account_Type_Tag.all    /=
446
               Ada.Tags.External_Tag(
447
                 Savings_Account_Type'Class(Savings_Account)'Tag)
448
            then
449
               Report.Failed("Incorrect Savings_Account tag");
450
            end if;
451
 
452
         exception
453
            when others =>
454
              Report.Failed ("Exception raised during tag evaluation");
455
         end Tag_Verification_Block;
456
 
457
      exception
458
         when others => Report.Failed ("Exception in Read_Data");
459
      end Read_Data;
460
 
461
      begin  -- Test_Block
462
 
463
      -- Enter the data into the appropriate files.
464
      Buffer_Data;
465
 
466
      -- Reconstruct the data from files, and verify the results.
467
      Read_Data;
468
 
469
   exception
470
      when others => Report.Failed ("Exception raised in Test_Block");
471
   end Test_Block;
472
 
473
   Report.Result;
474
 
475
exception
476
   when Incomplete =>
477
      Report.Result;
478
   when others     =>
479
      Report.Failed ( "Unexpected exception" );
480
      Report.Result;
481
 
482
end CXA9002;

powered by: WebSVN 2.1.0

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