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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXACC01.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 use of 'Class'Output and 'Class'Input allow stream
28
--      manipulation of objects of non-limited class-wide types.
29
--
30
-- TEST DESCRIPTION:
31
--      This test demonstrates the uses of 'Class'Output and 'Class'Input
32
--      in moving objects of a particular class to and from a stream file.
33
--      A procedure uses a class-wide parameter to move objects of specific
34
--      types in the class to the stream, using the 'Class'Output attribute
35
--      of the root type of the class.  A function returns a class-wide object,
36
--      using the 'Class'Input attribute of the root type of the class to
37
--      extract the object from the stream.
38
--      A field-by-field comparison of record objects is performed to validate
39
--      the data read from the stream.  Operator precedence rules are used
40
--      in the comparison rather than parentheses.
41
--
42
-- APPLICABILITY CRITERIA:
43
--      This test is applicable to all implementations capable of supporting
44
--      external Stream_IO files.
45
--
46
--
47
-- CHANGE HISTORY:
48
--      06 Dec 94   SAIC    ACVC 2.0
49
--      14 Nov 95   SAIC    Corrected prefix of 'Tag attribute for ACVC 2.0.1.
50
--      24 Aug 96   SAIC    Changed a call to "Create" to "Reset".
51
--      26 Feb 97   CTA.PWB Allowed for non-support of some IO operations.
52
--!
53
 
54
with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report;
55
 
56
procedure CXACC01 is
57
 
58
   Order_File     : Ada.Streams.Stream_IO.File_Type;
59
   Order_Stream   : Ada.Streams.Stream_IO.Stream_Access;
60
   Order_Filename : constant String :=
61
                           Report.Legal_File_Name ( Nam => "CXACC01" );
62
   Incomplete : exception;
63
 
64
begin
65
 
66
   Report.Test ("CXACC01", "Check that the use of 'Class'Output "        &
67
                           "and 'Class'Input allow stream manipulation " &
68
                           "of objects of non-limited class-wide types");
69
 
70
   Test_for_Stream_IO_Support:
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 (Order_File,
81
                                    Ada.Streams.Stream_IO.Out_File,
82
                                    Order_Filename);
83
 
84
   exception
85
 
86
       when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
87
          Report.Not_Applicable
88
             ( "Files not supported - Create as Out_File for Stream_IO" );
89
          raise Incomplete;
90
 
91
   end Test_for_Stream_IO_Support;
92
 
93
   Operational_Test_Block:
94
   declare
95
 
96
      -- Store tag values associated with objects of tagged types.
97
 
98
      TC_Box_Office_Tag : constant String :=
99
        Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag);
100
 
101
      TC_Summer_Tag     : constant String :=
102
        Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag);
103
 
104
      TC_Mayoral_Tag    : constant String :=
105
        Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag);
106
 
107
      TC_Late_Tag       : constant String :=
108
        Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag);
109
 
110
         -- The following procedure will take an object of the Ticket_Request
111
         -- class and output it to the stream.  Objects of any extended type
112
         -- in the class can be output to the stream with this procedure.
113
 
114
      procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is
115
      begin
116
         FXACC00.Ticket_Request'Class'Output (Order_Stream, Order);
117
      end Order_Entry;
118
 
119
 
120
      -- The following function will retrieve from the stream an object of
121
      -- the Ticket_Request class.
122
 
123
      function Order_Retrieval return FXACC00.Ticket_Request'Class is
124
      begin
125
         return FXACC00.Ticket_Request'Class'Input (Order_Stream);
126
      end Order_Retrieval;
127
 
128
   begin
129
 
130
      Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File);
131
 
132
      -- Store the data objects in the stream.
133
      -- Each of the objects is of a different type within the class.
134
 
135
      Order_Entry (FXACC00.Box_Office_Request);     -- Object of root type
136
      Order_Entry (FXACC00.Summer_Subscription);    -- Obj. of extended type
137
      Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type
138
      Order_Entry (FXACC00.Late_Request);           -- Object of twice
139
                                                    -- extended type.
140
 
141
      -- Reset mode of stream to In_File prior to reading data from it.
142
      Reset1:
143
      begin
144
         Ada.Streams.Stream_IO.Reset (Order_File,
145
                                      Ada.Streams.Stream_IO.In_File);
146
      exception
147
         when Ada.Streams.Stream_IO.Use_Error =>
148
            Report.Not_Applicable
149
               ( "Reset to In_File not supported for Stream_IO - 1" );
150
            raise Incomplete;
151
      end Reset1;
152
 
153
      Process_Order_Block:
154
      declare
155
 
156
         use FXACC00;
157
 
158
         -- Declare variables of the root type class,
159
         -- and initialize them with class-wide objects returned from
160
         -- the stream as function result.
161
 
162
         Order_1 : Ticket_Request'Class := Order_Retrieval;
163
         Order_2 : Ticket_Request'Class := Order_Retrieval;
164
         Order_3 : Ticket_Request'Class := Order_Retrieval;
165
         Order_4 : Ticket_Request'Class := Order_Retrieval;
166
 
167
         -- Declare objects of the specific types from within the class
168
         -- that correspond to the types of the data written to the
169
         -- stream.  Perform a type conversion on the class-wide objects.
170
 
171
         Ticket_Order      : Ticket_Request :=
172
                                Ticket_Request(Order_1);
173
         Subscriber_Order  : Subscriber_Request :=
174
                                Subscriber_Request(Order_2);
175
         VIP_Order         : VIP_Request :=
176
                                VIP_Request(Order_3);
177
         Last_Minute_Order : Last_Minute_Request :=
178
                                Last_Minute_Request(Order_4);
179
 
180
      begin
181
 
182
         -- Perform a field-by-field comparison of all the class-wide
183
         -- objects input from the stream with specific type objects
184
         -- originally written to the stream.
185
 
186
         if Ticket_Order.Location                /=
187
            Box_Office_Request.Location          or
188
            Ticket_Order.Number_Of_Tickets       /=
189
            Box_Office_Request.Number_Of_Tickets
190
         then
191
            Report.Failed ("Ticket_Request object validation failure");
192
         end if;
193
 
194
         if Subscriber_Order.Location               /=
195
            Summer_Subscription.Location            or
196
            Subscriber_Order.Number_Of_Tickets      /=
197
            Summer_Subscription.Number_Of_Tickets   or
198
            Subscriber_Order.Subscription_Number    /=
199
            Summer_Subscription.Subscription_Number
200
         then
201
            Report.Failed ("Subscriber_Request object validation failure");
202
         end if;
203
 
204
         if VIP_Order.Location                       /=
205
            Mayoral_Ticket_Request.Location          or
206
            VIP_Order.Number_Of_Tickets              /=
207
            Mayoral_Ticket_Request.Number_Of_Tickets or
208
            VIP_Order.Rank                           /=
209
            Mayoral_Ticket_Request.Rank
210
         then
211
            Report.Failed ("VIP_Request object validation failure");
212
         end if;
213
 
214
         if Last_Minute_Order.Location               /=
215
            Late_Request.Location                    or
216
            Last_Minute_Order.Number_Of_Tickets      /=
217
            Late_Request.Number_Of_Tickets           or
218
            Last_Minute_Order.Rank                   /=
219
            Late_Request.Rank                        or
220
            Last_Minute_Order.Special_Consideration  /=
221
            Late_Request.Special_Consideration       or
222
            Last_Minute_Order.Donation               /=
223
            Late_Request.Donation
224
         then
225
            Report.Failed ("Last_Minute_Request object validation failure");
226
         end if;
227
 
228
         -- Verify tag values from before and after processing.
229
         -- The 'Tag attribute is used with objects of a class-wide type.
230
 
231
         if TC_Box_Office_Tag /=
232
            Ada.Tags.External_Tag(Order_1'Tag)
233
         then
234
            Report.Failed("Failed tag comparison - 1");
235
         end if;
236
 
237
         if TC_Summer_Tag /=
238
            Ada.Tags.External_Tag(Order_2'Tag)
239
         then
240
            Report.Failed("Failed tag comparison - 2");
241
         end if;
242
 
243
         if TC_Mayoral_Tag /=
244
            Ada.Tags.External_Tag(Order_3'Tag)
245
         then
246
            Report.Failed("Failed tag comparison - 3");
247
         end if;
248
 
249
         if TC_Late_Tag /=
250
            Ada.Tags.External_Tag(Order_4'Tag)
251
         then
252
            Report.Failed("Failed tag comparison - 4");
253
         end if;
254
 
255
      end Process_Order_Block;
256
 
257
         -- After all the data has been correctly extracted, the file
258
         -- should be empty.
259
 
260
      if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then
261
         Report.Failed ("Stream file not empty");
262
      end if;
263
 
264
   exception
265
      when Incomplete =>
266
         raise;
267
      when Constraint_Error =>
268
         Report.Failed ("Constraint_Error raised in Operational Block");
269
      when others =>
270
         Report.Failed ("Exception raised in Operational Test Block");
271
   end Operational_Test_Block;
272
 
273
   Deletion:
274
   begin
275
      if Ada.Streams.Stream_IO.Is_Open (Order_File) then
276
         Ada.Streams.Stream_IO.Delete (Order_File);
277
      else
278
         Ada.Streams.Stream_IO.Open (Order_File,
279
                                     Ada.Streams.Stream_IO.Out_File,
280
                                     Order_Filename);
281
         Ada.Streams.Stream_IO.Delete (Order_File);
282
      end if;
283
   exception
284
      when others =>
285
         Report.Failed
286
            ( "Delete not properly implemented for Stream_IO" );
287
   end Deletion;
288
 
289
   Report.Result;
290
 
291
exception
292
 
293
   when Incomplete =>
294
      Report.Result;
295
   when others     =>
296
      Report.Failed ( "Unexpected exception" );
297
      Report.Result;
298
 
299
end CXACC01;

powered by: WebSVN 2.1.0

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