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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C392A01.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 a class-wide formal parameter allows for the
28
 --      proper dispatching of objects to the appropriate implementation of
29
 --      a primitive operation.  Check this for the root tagged type defined
30
 --      in a package, and the extended type is defined in that same package.
31
 --
32
 -- TEST DESCRIPTION:
33
 --      Declare a root tagged type, and some associated primitive operations.
34
 --      Extend the root type, and override one or more primitive operations,
35
 --      inheriting the other primitive operations from the root type.
36
 --      Derive from the extended type, again overriding some primitive
37
 --      operations and inheriting others (including some that the parent
38
 --      inherited).
39
 --      Define a subprogram with a class-wide parameter, inside of which is a
40
 --      call on a dispatching primitive operation.  These primitive operations
41
 --      modify global variables (the class-wide parameter has mode IN).
42
 --
43
 --
44
 --
45
 -- The following hierarchy of tagged types and primitive operations is
46
 -- utilized in this test:
47
 --
48
 --    type Bank_Account (root)
49
 --            |
50
 --            | Operations
51
 --            |   Increment_Bank_Reserve
52
 --            |   Assign_Representative
53
 --            |   Increment_Counters
54
 --            |   Open
55
 --            |
56
 --    type Savings_Account (extended from Bank_Account)
57
 --            |
58
 --            | Operations
59
 --            |   (Increment_Bank_Reserve) (inherited)
60
 --            |   Assign_Representative    (overridden)
61
 --            |   Increment_Counters       (overridden)
62
 --            |   Open                     (overridden)
63
 --            |
64
 --    type Preferred_Account (extended from Savings_Account)
65
 --            |
66
 --            | Operations
67
 --            |   (Increment_Bank_Reserve) (inherited twice - Bank_Acct.)
68
 --            |   (Assign_Representative)  (inherited - Savings_Acct.)
69
 --            |   Increment_Counters       (overridden)
70
 --            |   Open                     (overridden)
71
 --
72
 --
73
 -- In this test, we are concerned with the following selection of dispatching
74
 -- calls, accomplished with the use of a Bank_Account'Class IN procedure
75
 -- parameter :
76
 --
77
 --                       \ Type
78
 --               Prim. Op \  Bank_Account  Savings_Account Preferred_Account
79
 --                         \------------------------------------------------
80
 --   Increment_Bank_Reserve|      X               X               X
81
 --   Assign_Representative |                      X
82
 --   Increment_Counters    |      X               X               X
83
 --
84
 --
85
 --
86
 -- The location of the declaration and derivation of the root and extended
87
 -- types will be varied over a series of tests.  Locations of declaration
88
 -- and derivation for a particular test are marked with an asterisk (*).
89
 --
90
 -- Root type:
91
 --
92
 --    *  Declared in package.
93
 --       Declared in generic package.
94
 --
95
 -- Extended types:
96
 --
97
 --    *  Derived in parent location.
98
 --       Derived in a nested package.
99
 --       Derived in a nested subprogram.
100
 --       Derived in a nested generic package.
101
 --       Derived in a separate package.
102
 --       Derived in a separate visible child package.
103
 --       Derived in a separate private child package.
104
 --
105
 -- Primitive Operations:
106
 --
107
 --    *  Procedures with same parameter profile.
108
 --       Procedures with different parameter profile.
109
 --       Functions with same parameter profile.
110
 --       Functions with different parameter profile.
111
 --       Mixture of Procedures and Functions.
112
 --
113
 --
114
 -- TEST FILES:
115
 --      This test depends on the following foundation code:
116
 --
117
 --         F392A00.A
118
 --
119
 --      The following files comprise this test:
120
 --
121
 --      => C392A01.A
122
 --
123
 --
124
-- CHANGE HISTORY:
125
--      06 Dec 94   SAIC    ACVC 2.0
126
--
127
 --!
128
 
129
 with F392A00;         -- package Accounts
130
 with Report;
131
 
132
 procedure C392A01 is
133
 
134
    package Accounts renames F392A00;
135
 
136
    -- Declare account objects.
137
 
138
    B_Account : Accounts.Bank_Account;
139
    S_Account : Accounts.Savings_Account;
140
    P_Account : Accounts.Preferred_Account;
141
 
142
    -- Procedures to operate on accounts.
143
    -- Each uses a class-wide IN parameter, as well as a call to a
144
    -- dispatching operation.
145
 
146
    -- Procedure Tabulate_Account performs a dispatching call on a primitive
147
    -- operation that has been overridden for each of the extended types.
148
 
149
    procedure Tabulate_Account (Acct : in Accounts.Bank_Account'Class) is
150
    begin
151
       Accounts.Increment_Counters (Acct);   -- Dispatch according to tag.
152
    end Tabulate_Account;
153
 
154
 
155
    -- Procedure Accumulate_Reserve performs a dispatching call on a
156
    -- primitive operation that has been defined for the root type and
157
    -- inherited by each derived type.
158
 
159
    procedure Accumulate_Reserve (Acct : in Accounts.Bank_Account'Class) is
160
    begin
161
       Accounts.Increment_Bank_Reserve (Acct);   -- Dispatch according to tag.
162
    end Accumulate_Reserve;
163
 
164
 
165
    -- Procedure Resolve_Dispute performs a dispatching call on a primitive
166
    -- operation that has been defined in the root type, overridden in the
167
    -- first derived extended type, and inherited by the subsequent extended
168
    -- type.
169
 
170
    procedure Resolve_Dispute (Acct : in Accounts.Bank_Account'Class) is
171
    begin
172
       Accounts.Assign_Representative (Acct);   -- Dispatch according to tag.
173
    end Resolve_Dispute;
174
 
175
 
176
 
177
 begin  -- Main test procedure.
178
 
179
    Report.Test ("C392A01", "Check that the use of a class-wide parameter "   &
180
                             "allows for proper dispatching where root type " &
181
                             "and extended types are declared in the same "   &
182
                             "package" );
183
 
184
    Bank_Account_Subtest:
185
    declare
186
      use Accounts;
187
    begin
188
       Accounts.Open (B_Account);
189
 
190
       -- Demonstrate class-wide parameter allowing dispatch by a primitive
191
       -- operation that has been defined for this specific type.
192
       Accumulate_Reserve (Acct => B_Account);
193
       Tabulate_Account (B_Account);
194
 
195
       if (Accounts.Bank_Reserve /= Accounts.Opening_Balance) or
196
          (Accounts.Number_Of_Accounts (Bank) /= 1)           or
197
          (Accounts.Number_Of_Accounts (Total) /= 1)
198
       then
199
          Report.Failed ("Failed in Bank_Account_Subtest");
200
       end if;
201
 
202
    end Bank_Account_Subtest;
203
 
204
 
205
    Savings_Account_Subtest:
206
    declare
207
      use Accounts;
208
    begin
209
       Accounts.Open (Acct => S_Account);
210
 
211
       -- Demonstrate class-wide parameter allowing dispatch by a primitive
212
       -- operation that has been inherited by this extended type.
213
       Accumulate_Reserve (Acct => S_Account);
214
 
215
       -- Demonstrate class-wide parameter allowing dispatch by a primitive
216
       -- operation that has been overridden for this extended type.
217
       Resolve_Dispute  (Acct => S_Account);
218
       Tabulate_Account (S_Account);
219
 
220
       if Accounts.Bank_Reserve /= (3.0 * Accounts.Opening_Balance) or
221
          Accounts.Daily_Representative /= Accounts.Manager         or
222
          Accounts.Number_Of_Accounts (Savings) /= 1                or
223
          Accounts.Number_Of_Accounts (Total) /= 2
224
       then
225
          Report.Failed ("Failed in Savings_Account_Subtest");
226
       end if;
227
 
228
    end Savings_Account_Subtest;
229
 
230
 
231
    Preferred_Account_Subtest:
232
    declare
233
      use Accounts;
234
    begin
235
       Accounts.Open (P_Account);
236
 
237
       -- Verify that the correct implementation of Open (overridden) was
238
       -- used for the Preferred_Account object.
239
       if not Accounts.Verify_Open (P_Account) then
240
          Report.Failed ("Incorrect values for init. Preferred Acct object");
241
       end if;
242
 
243
       -- Demonstrate class-wide parameter allowing dispatch by a primitive
244
       -- operation that has been twice inherited by this extended type.
245
       Accumulate_Reserve (Acct => P_Account);
246
 
247
       -- Demonstrate class-wide parameter allowing dispatch by a primitive
248
       -- operation that has been overridden for this extended type (the
249
       -- operation was overridden by its parent type as well).
250
       Tabulate_Account (P_Account);
251
 
252
       if Accounts.Bank_Reserve /= 1300.00             or
253
          Accounts.Number_Of_Accounts (Preferred) /= 1 or
254
          Accounts.Number_Of_Accounts (Total) /= 3
255
       then
256
          Report.Failed ("Failed in Preferred_Account_Subtest");
257
       end if;
258
 
259
    end Preferred_Account_Subtest;
260
 
261
 
262
    Report.Result;
263
 
264
 end C392A01;
265
 

powered by: WebSVN 2.1.0

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