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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXACA02.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 user defined subprograms can override the default
28
--      attributes 'Read and 'Write using attribute definition clauses.
29
--      Use objects of record types.
30
--
31
-- TEST DESCRIPTION:
32
--      This test demonstrates that the default implementations of the
33
--      'Read and 'Write attributes can be overridden by user specified
34
--      subprograms in conjunction with attribute definition clauses.
35
--      These attributes have been overridden below, and in the user defined
36
--      substitutes, values are added or subtracted to global variables.
37
--      The global variables are evaluated to ensure that the user defined
38
--      subprograms were used in overriding the type-related default
39
--      attributes.
40
--
41
-- APPLICABILITY CRITERIA:
42
--      Applicable to all implementations that support external
43
--      Stream_IO files.
44
--
45
--
46
-- CHANGE HISTORY:
47
--      06 Dec 94   SAIC    ACVC 2.0
48
--      21 Nov 95   SAIC    Corrected recursive attribute definitions
49
--                          for ACVC 2.0.1.
50
--      24 Aug 96   SAIC    Corrected typo in test verification criteria.
51
--
52
--!
53
 
54
with Report;
55
with Ada.Streams.Stream_IO;
56
 
57
procedure CXACA02 is
58
begin
59
 
60
   Report.Test ("CXACA02", "Check that user defined subprograms can "   &
61
                           "override the default attributes 'Read and " &
62
                           "'Write using attribute definition clauses");
63
 
64
   Test_for_Stream_IO_Support:
65
   declare
66
 
67
      Data_File      : Ada.Streams.Stream_IO.File_Type;
68
      Data_Stream    : Ada.Streams.Stream_IO.Stream_Access;
69
      The_Filename   : constant String := Report.Legal_File_Name;
70
 
71
   begin
72
 
73
      -- If an implementation does not support Stream_IO in a particular
74
      -- environment, the exception Use_Error or Name_Error will be raised on
75
      -- calls to various Stream_IO operations.  This block statement
76
      -- encloses a call to Create, which should produce an exception in a
77
      -- non-supportive environment.  These exceptions will be handled to
78
      -- produce a Not_Applicable result.
79
 
80
      Ada.Streams.Stream_IO.Create (Data_File,
81
                                    Ada.Streams.Stream_IO.Out_File,
82
                                    The_Filename);
83
 
84
      Operational_Test_Block:
85
      declare
86
 
87
         type Origin_Type is (Foreign, Domestic);
88
         subtype String_Data_Type is String(1..8);
89
 
90
         type Product_Type is
91
            record
92
               Item        : String_Data_Type;
93
               ID          : Natural range 1..100;
94
               Manufacture : Origin_Type := Domestic;
95
               Distributor : String_Data_Type;
96
               Importer    : String_Data_Type;
97
            end record;
98
 
99
         type Sales_Record_Type is
100
            record
101
               Name              : String_Data_Type;
102
               Sale_Item         : Boolean := False;
103
               Buyer             : Origin_Type;
104
               Quantity_Discount : Boolean;
105
               Cash_Discount     : Boolean;
106
            end record;
107
 
108
 
109
         -- Mode conformant, user defined subprograms that will override
110
         -- the type-related attributes.
111
         -- In this test, the user defines these subprograms to add/subtract
112
         -- specific values from global variables.
113
 
114
         procedure Product_Read
115
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
116
             The_Item : out Product_Type );
117
 
118
         procedure Product_Write
119
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
120
             The_Item : Product_Type );
121
 
122
         procedure Sales_Read
123
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
124
             The_Item : out Sales_Record_Type );
125
 
126
         procedure Sales_Write
127
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
128
             The_Item : Sales_Record_Type );
129
 
130
         -- Attribute definition clauses.
131
 
132
         for Product_Type'Read  use Product_Read;
133
         for Product_Type'Write use Product_Write;
134
 
135
         for Sales_Record_Type'Read  use Sales_Read;
136
         for Sales_Record_Type'Write use Sales_Write;
137
 
138
 
139
         -- Object Declarations
140
 
141
         Product_01 : Product_Type :=
142
           ("Product1", 1, Domestic, "Distrib1", "Import 1");
143
         Product_02 : Product_Type :=
144
           ("Product2", 2, Foreign,  "Distrib2", "Import 2");
145
 
146
         Sale_Rec_01 : Sales_Record_Type :=
147
           ("Buyer 01", False, Domestic, True, True);
148
         Sale_Rec_02 : Sales_Record_Type :=
149
           ("Buyer 02", True,  Domestic, True, False);
150
         Sale_Rec_03 : Sales_Record_Type := (Name              => "Buyer 03",
151
                                             Sale_Item         => True,
152
                                             Buyer             => Foreign,
153
                                             Quantity_Discount => False,
154
                                             Cash_Discount     => True);
155
         Sale_Rec_04 : Sales_Record_Type :=
156
           ("Buyer 04", True,  Foreign,  False, False);
157
         Sale_Rec_05 : Sales_Record_Type :=
158
           ("Buyer 05", False, Foreign,  False, False);
159
 
160
         TC_Read_Total  : Integer := 100;
161
         TC_Write_Total : Integer :=   0;
162
 
163
 
164
         -- Subprogram bodies.
165
         -- These subprograms are designed to override the default attributes
166
         -- 'Read and 'Write for the specified types.  Each adds/subtracts
167
         -- a quantity to/from a program control variable, indicating its
168
         -- activity.   In addition, each component of the record is
169
         -- individually read from or written to the stream, using the
170
         -- appropriate 'Read or 'Write attribute for the component type.
171
         -- The string components are moved to/from the stream using the
172
         -- 'Input and 'Output attributes for the string subtype, so that
173
         -- the bounds of the strings are also written/read.
174
 
175
         procedure Product_Read
176
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
177
             The_Item : out Product_Type ) is
178
         begin
179
            TC_Read_Total := TC_Read_Total - 10;
180
 
181
            The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1.
182
            Natural'Read(Data_Stream, The_Item.ID);               -- Field 2.
183
            Origin_Type'Read(Data_Stream,                         -- Field 3.
184
                             The_Item.Manufacture);
185
            The_Item.Distributor :=                               -- Field 4.
186
              String_Data_Type'Input(Data_Stream);
187
            The_Item.Importer    :=                               -- Field 5.
188
              String_Data_Type'Input(Data_Stream);
189
         end Product_Read;
190
 
191
 
192
         procedure Product_Write
193
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
194
             The_Item : Product_Type ) is
195
         begin
196
            TC_Write_Total := TC_Write_Total + 5;
197
 
198
            String_Data_Type'Output(Data_Stream, The_Item.Item);  -- Field 1.
199
            Natural'Write(Data_Stream, The_Item.ID);              -- Field 2.
200
            Origin_Type'Write(Data_Stream,                        -- Field 3.
201
                             The_Item.Manufacture);
202
            String_Data_Type'Output(Data_Stream,                  -- Field 4.
203
                                    The_Item.Distributor);
204
            String_Data_Type'Output(Data_Stream,                  -- Field 5.
205
                                    The_Item.Importer);
206
         end Product_Write;
207
 
208
 
209
         procedure Sales_Read
210
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
211
             The_Item : out Sales_Record_Type ) is
212
         begin
213
            TC_Read_Total := TC_Read_Total - 20;
214
 
215
            The_Item.Name := String_Data_Type'Input(Data_Stream);  -- Field 1.
216
            Boolean'Read(Data_Stream, The_Item.Sale_Item);         -- Field 2.
217
            Origin_Type'Read(Data_Stream, The_Item.Buyer);         -- Field 3.
218
            Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
219
            Boolean'Read(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
220
         end Sales_Read;
221
 
222
 
223
         procedure Sales_Write
224
           ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
225
             The_Item : Sales_Record_Type ) is
226
         begin
227
            TC_Write_Total := TC_Write_Total + 10;
228
 
229
            String_Data_Type'Output(Data_Stream, The_Item.Name);    -- Field 1.
230
            Boolean'Write(Data_Stream, The_Item.Sale_Item);         -- Field 2.
231
            Origin_Type'Write(Data_Stream, The_Item.Buyer);         -- Field 3.
232
            Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
233
            Boolean'Write(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
234
         end Sales_Write;
235
 
236
 
237
 
238
      begin
239
 
240
         Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File);
241
 
242
         -- Write product and sales data to the stream.
243
 
244
         Product_Type'Write      (Data_Stream, Product_01);
245
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_01);
246
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_02);
247
 
248
         Product_Type'Write      (Data_Stream, Product_02);
249
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_03);
250
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_04);
251
         Sales_Record_Type'Write (Data_Stream, Sale_Rec_05);
252
 
253
         -- Read data from the stream, and verify the use of the user specified
254
         -- attributes.
255
 
256
         Verify_Data_Block:
257
         declare
258
 
259
            TC_Product1,
260
            TC_Product2 : Product_Type;
261
 
262
            TC_Sale1,
263
            TC_Sale2,
264
            TC_Sale3,
265
            TC_Sale4,
266
            TC_Sale5    : Sales_Record_Type;
267
 
268
         begin
269
 
270
            -- Reset the mode of the stream file so that Read/Input
271
            -- operations may be performed.
272
 
273
            Ada.Streams.Stream_IO.Reset (Data_File,
274
                                         Ada.Streams.Stream_IO.In_File);
275
 
276
            -- Data is read/reconstructed from the stream, in the order that
277
            -- the data was placed into the stream.
278
 
279
            Product_Type'Read      (Data_Stream, TC_Product1);
280
            Sales_Record_Type'Read (Data_Stream, TC_Sale1);
281
            Sales_Record_Type'Read (Data_Stream, TC_Sale2);
282
 
283
            Product_Type'Read      (Data_Stream, TC_Product2);
284
            Sales_Record_Type'Read (Data_Stream, TC_Sale3);
285
            Sales_Record_Type'Read (Data_Stream, TC_Sale4);
286
            Sales_Record_Type'Read (Data_Stream, TC_Sale5);
287
 
288
            -- Verify product data was correctly written to/read from stream.
289
 
290
            if TC_Product1 /= Product_01 then
291
               Report.Failed ("Data verification error, Product 1");
292
            end if;
293
            if TC_Product2 /= Product_02 then
294
               Report.Failed ("Data verification error, Product 2");
295
            end if;
296
 
297
            if TC_Sale1 /= Sale_Rec_01 then
298
               Report.Failed ("Data verification error, Sale_Rec_01");
299
            end if;
300
            if TC_Sale2 /= Sale_Rec_02 then
301
               Report.Failed ("Data verification error, Sale_Rec_02");
302
            end if;
303
            if TC_Sale3 /= Sale_Rec_03 then
304
               Report.Failed ("Data verification error, Sale_Rec_03");
305
            end if;
306
            if TC_Sale4 /= Sale_Rec_04 then
307
               Report.Failed ("Data verification error, Sale_Rec_04");
308
            end if;
309
            if TC_Sale5 /= Sale_Rec_05 then
310
               Report.Failed ("Data verification error, Sale_Rec_05");
311
            end if;
312
 
313
            -- Verify that the user defined subprograms were used to
314
            -- override the default 'Read and 'Write attributes.
315
            -- There were two "product" reads and two writes; there
316
            -- were five "sale record" reads and five writes.
317
 
318
            if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then
319
               Report.Failed ("Incorrect use of user defined attributes");
320
            end if;
321
 
322
         end Verify_Data_Block;
323
 
324
      exception
325
 
326
         when others =>
327
            Report.Failed ("Exception raised in Operational Test Block");
328
 
329
      end Operational_Test_Block;
330
 
331
      if Ada.Streams.Stream_IO.Is_Open (Data_File) then
332
         Ada.Streams.Stream_IO.Delete (Data_File);
333
      else
334
         Ada.Streams.Stream_IO.Open (Data_File,
335
                                     Ada.Streams.Stream_IO.Out_File,
336
                                     The_Filename);
337
         Ada.Streams.Stream_IO.Delete (Data_File);
338
      end if;
339
 
340
 
341
   exception
342
 
343
      -- Since Use_Error or Name_Error can be raised if, for the specified
344
      -- mode, the environment does not support Stream_IO operations,
345
      -- the following handlers are included:
346
 
347
      when Ada.Streams.Stream_IO.Name_Error =>
348
         Report.Not_Applicable ("Name_Error raised on Stream IO Create");
349
 
350
      when Ada.Streams.Stream_IO.Use_Error  =>
351
         Report.Not_Applicable ("Use_Error raised on Stream IO Create");
352
 
353
      when others                           =>
354
         Report.Failed ("Unexpected exception raised");
355
 
356
   end Test_for_Stream_IO_Support;
357
 
358
   Report.Result;
359
 
360
end CXACA02;

powered by: WebSVN 2.1.0

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