3 -- Grant of Unlimited Rights
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
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.
27 -- Check that class-wide objects can be reassigned with objects from
28 -- the same specific type used to initialize them.
31 -- Define new objects of specific types from within a class. Reassign
32 -- previously declared class-wide objects with the new specific type
33 -- objects. Check that new assignments were performed.
35 -- The particular root and extended types used in this abstraction are
36 -- defined in foundation code (F341A00.A), and are graphically displayed
49 -- package Interest_Checking
53 -- This test depends on the following foundation code:
57 -- The following files comprise this test:
63 -- 06 Dec 94 SAIC ACVC 2.0
67 with F341A00_0
; -- package Bank
68 with F341A00_1
; -- package Checking
69 with F341A00_2
; -- package Interest_Checking
74 package Bank
renames F341A00_0
;
75 package Checking
renames F341A00_1
;
76 package Interest_Checking
renames F341A00_2
;
78 Max_Accts
: constant := 3;
79 Bank_Balance
: Bank
.Dollar_Amount
:= 0.00;
81 -- Define and initialize objects of specific types.
82 B_Acct
: aliased Bank
.Account
:= (Current_Balance
=> 10.00);
83 C_Acct
: aliased Checking
.Account
:= (100.00, 10.00);
84 IC_Acct
: aliased Interest_Checking
.Account
:= (1000.00, 10.00, 0.030);
85 New_B_Acct
: aliased Bank
.Account
:= (Current_Balance
=> 20.00);
86 New_C_Acct
: aliased Checking
.Account
:= (200.00, 20.00);
87 New_IC_Acct
: aliased Interest_Checking
.Account
:= (2000.00, 20.00, 0.060);
90 -- Define and initialize (by direct assignment) objects of a class-wide
91 -- type originating from the root type (Bank.Account).
93 type ATM_Card
is access all Bank
.Account
'Class;
95 Accounts
: array (1 .. Max_Accts
) of ATM_Card
:=
96 (1 => B_Acct
'Access, 2 => C_Acct
'Access, 3 => IC_Acct
'Access);
98 New_Accounts
: array (1 .. Max_Accts
) of ATM_Card
:=
99 (1 => New_B_Acct
'Access,
100 2 => New_C_Acct
'Access,
101 3 => New_IC_Acct
'Access);
103 -- Define an account auditing procedure with a class-wide
104 -- variable that can hold a value of any object within the class,
105 -- and once initialized, can hold other values of the same specific type.
107 procedure Audit
(Num
: in integer;
108 Amt
: out Bank
.Dollar_Amount
) is
109 Account_Being_Audited
: Bank
.Account
'Class := Accounts
(Num
).all;
110 use type Bank
.Dollar_Amount
;
112 Amt
:= Account_Being_Audited
.Current_Balance
;
113 -- Reassign class-wide variable to another object of the type used to
115 Account_Being_Audited
:= New_Accounts
(Num
).all;
116 Amt
:= Amt
+ Account_Being_Audited
.Current_Balance
; -- Reading OUT
117 end Audit
; -- parameter.
122 Report
.Test
("C341A02", "Check that class-wide objects can be " &
123 "reassigned with objects from the same " &
124 "specific type used to initialize them" );
127 use type Bank
.Dollar_Amount
;
128 Acct_Value
: Bank
.Dollar_Amount
:= 0.00;
130 -- Perform nightly audit of total funds on deposit in bank.
131 for i
in 1 .. Max_Accts
loop
132 Audit
(i
, Acct_Value
);
133 Bank_Balance
:= Bank_Balance
+ Acct_Value
;
136 if Bank_Balance
/= 3330.00 then
137 Report
.Failed
("Class-wide object processing failed");