-- C392008.A
|
-- C392008.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
-- unlimited rights in the software and documentation contained herein.
|
-- unlimited rights in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- released technical data and computer software in whole or in part, in
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that the use of a class-wide formal parameter allows for the
|
-- Check that the use of a class-wide formal parameter allows for the
|
-- proper dispatching of objects to the appropriate implementation of
|
-- proper dispatching of objects to the appropriate implementation of
|
-- a primitive operation. Check this for the case where the root tagged
|
-- a primitive operation. Check this for the case where the root tagged
|
-- type is defined in a package and the extended type is defined in a
|
-- type is defined in a package and the extended type is defined in a
|
-- dependent package.
|
-- dependent package.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare a root tagged type, and some associated primitive operations,
|
-- Declare a root tagged type, and some associated primitive operations,
|
-- in a visible library package.
|
-- in a visible library package.
|
-- Extend the root type in another visible library package, and override
|
-- Extend the root type in another visible library package, and override
|
-- one or more primitive operations, inheriting the other primitive
|
-- one or more primitive operations, inheriting the other primitive
|
-- operations from the root type.
|
-- operations from the root type.
|
-- Derive from the extended type in yet another visible library package,
|
-- Derive from the extended type in yet another visible library package,
|
-- again overriding some primitive operations and inheriting others
|
-- again overriding some primitive operations and inheriting others
|
-- (including some that the parent inherited).
|
-- (including some that the parent inherited).
|
-- Define subprograms with class-wide parameters, inside of which is a
|
-- Define subprograms with class-wide parameters, inside of which is a
|
-- call on a dispatching primitive operation. These primitive
|
-- call on a dispatching primitive operation. These primitive
|
-- operations modify the objects of the specific class passed as actuals
|
-- operations modify the objects of the specific class passed as actuals
|
-- to the class-wide formal parameter (class-wide formal parameter has
|
-- to the class-wide formal parameter (class-wide formal parameter has
|
-- mode IN OUT).
|
-- mode IN OUT).
|
--
|
--
|
-- The following hierarchy of tagged types and primitive operations is
|
-- The following hierarchy of tagged types and primitive operations is
|
-- utilized in this test:
|
-- utilized in this test:
|
--
|
--
|
-- package Bank
|
-- package Bank
|
-- type Account (root)
|
-- type Account (root)
|
-- |
|
-- |
|
-- | Operations
|
-- | Operations
|
-- | proc Deposit
|
-- | proc Deposit
|
-- | proc Withdrawal
|
-- | proc Withdrawal
|
-- | func Balance
|
-- | func Balance
|
-- | proc Service_Charge
|
-- | proc Service_Charge
|
-- | proc Add_Interest
|
-- | proc Add_Interest
|
-- | proc Open
|
-- | proc Open
|
-- |
|
-- |
|
-- package Checking
|
-- package Checking
|
-- type Account (extended from Bank.Account)
|
-- type Account (extended from Bank.Account)
|
-- |
|
-- |
|
-- | Operations
|
-- | Operations
|
-- | proc Deposit (inherited)
|
-- | proc Deposit (inherited)
|
-- | proc Withdrawal (inherited)
|
-- | proc Withdrawal (inherited)
|
-- | func Balance (inherited)
|
-- | func Balance (inherited)
|
-- | proc Service_Charge (inherited)
|
-- | proc Service_Charge (inherited)
|
-- | proc Add_Interest (inherited)
|
-- | proc Add_Interest (inherited)
|
-- | proc Open (overridden)
|
-- | proc Open (overridden)
|
-- |
|
-- |
|
-- package Interest_Checking
|
-- package Interest_Checking
|
-- type Account (extended from Checking.Account)
|
-- type Account (extended from Checking.Account)
|
-- |
|
-- |
|
-- | Operations
|
-- | Operations
|
-- | proc Deposit (inherited twice - Bank.Acct.)
|
-- | proc Deposit (inherited twice - Bank.Acct.)
|
-- | proc Withdrawal (inherited twice - Bank.Acct.)
|
-- | proc Withdrawal (inherited twice - Bank.Acct.)
|
-- | func Balance (inherited twice - Bank.Acct.)
|
-- | func Balance (inherited twice - Bank.Acct.)
|
-- | proc Service_Charge (inherited twice - Bank.Acct.)
|
-- | proc Service_Charge (inherited twice - Bank.Acct.)
|
-- | proc Add_Interest (overridden)
|
-- | proc Add_Interest (overridden)
|
-- | proc Open (overridden)
|
-- | proc Open (overridden)
|
-- |
|
-- |
|
--
|
--
|
-- In this test, we are concerned with the following selection of dispatching
|
-- In this test, we are concerned with the following selection of dispatching
|
-- calls, accomplished with the use of a Bank.Account'Class IN OUT formal
|
-- calls, accomplished with the use of a Bank.Account'Class IN OUT formal
|
-- parameter :
|
-- parameter :
|
--
|
--
|
-- \ Type
|
-- \ Type
|
-- Prim. Op \ Bank.Account Checking.Account Interest_Checking.Account
|
-- Prim. Op \ Bank.Account Checking.Account Interest_Checking.Account
|
-- \---------------------------------------------------------
|
-- \---------------------------------------------------------
|
|
|
-- Service_Charge | X X X
|
-- Service_Charge | X X X
|
-- Add_Interest | X X X
|
-- Add_Interest | X X X
|
-- Open | X X X
|
-- Open | X X X
|
--
|
--
|
--
|
--
|
--
|
--
|
-- The location of the declaration of the root and derivation of extended
|
-- The location of the declaration of the root and derivation of extended
|
-- types will be varied over a series of tests. Locations of declaration
|
-- types will be varied over a series of tests. Locations of declaration
|
-- and derivation for a particular test are marked with an asterisk (*).
|
-- and derivation for a particular test are marked with an asterisk (*).
|
--
|
--
|
-- Root type:
|
-- Root type:
|
--
|
--
|
-- * Declared in package.
|
-- * Declared in package.
|
-- Declared in generic package.
|
-- Declared in generic package.
|
--
|
--
|
-- Extended types:
|
-- Extended types:
|
--
|
--
|
-- Derived in parent location.
|
-- Derived in parent location.
|
-- Derived in a nested package.
|
-- Derived in a nested package.
|
-- Derived in a nested subprogram.
|
-- Derived in a nested subprogram.
|
-- Derived in a nested generic package.
|
-- Derived in a nested generic package.
|
-- * Derived in a separate package.
|
-- * Derived in a separate package.
|
-- Derived in a separate visible child package.
|
-- Derived in a separate visible child package.
|
-- Derived in a separate private child package.
|
-- Derived in a separate private child package.
|
--
|
--
|
-- Primitive Operations:
|
-- Primitive Operations:
|
--
|
--
|
-- * Procedures with same parameter profile.
|
-- * Procedures with same parameter profile.
|
-- Procedures with different parameter profile.
|
-- Procedures with different parameter profile.
|
-- Functions with same parameter profile.
|
-- Functions with same parameter profile.
|
-- Functions with different parameter profile.
|
-- Functions with different parameter profile.
|
-- Mixture of Procedures and Functions.
|
-- Mixture of Procedures and Functions.
|
--
|
--
|
--
|
--
|
-- TEST FILES:
|
-- TEST FILES:
|
-- This test depends on the following foundation code:
|
-- This test depends on the following foundation code:
|
--
|
--
|
-- C392008_0.A
|
-- C392008_0.A
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 20 Nov 95 SAIC C392B04 became C392008 for ACVC 2.0.1
|
-- 20 Nov 95 SAIC C392B04 became C392008 for ACVC 2.0.1
|
--
|
--
|
--!
|
--!
|
|
|
----------------------------------------------------------------- C392008_0
|
----------------------------------------------------------------- C392008_0
|
|
|
package C392008_0 is -- package Bank
|
package C392008_0 is -- package Bank
|
|
|
type Dollar_Amount is range -30_000..30_000;
|
type Dollar_Amount is range -30_000..30_000;
|
|
|
type Account is tagged
|
type Account is tagged
|
record
|
record
|
Current_Balance: Dollar_Amount;
|
Current_Balance: Dollar_Amount;
|
end record;
|
end record;
|
|
|
-- Primitive operations.
|
-- Primitive operations.
|
|
|
procedure Deposit (A : in out Account;
|
procedure Deposit (A : in out Account;
|
X : in Dollar_Amount);
|
X : in Dollar_Amount);
|
procedure Withdrawal (A : in out Account;
|
procedure Withdrawal (A : in out Account;
|
X : in Dollar_Amount);
|
X : in Dollar_Amount);
|
function Balance (A : in Account) return Dollar_Amount;
|
function Balance (A : in Account) return Dollar_Amount;
|
procedure Service_Charge (A : in out Account);
|
procedure Service_Charge (A : in out Account);
|
procedure Add_Interest (A : in out Account);
|
procedure Add_Interest (A : in out Account);
|
procedure Open (A : in out Account);
|
procedure Open (A : in out Account);
|
|
|
end C392008_0;
|
end C392008_0;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
package body C392008_0 is
|
package body C392008_0 is
|
|
|
-- Primitive operations for type Account.
|
-- Primitive operations for type Account.
|
|
|
procedure Deposit (A : in out Account;
|
procedure Deposit (A : in out Account;
|
X : in Dollar_Amount) is
|
X : in Dollar_Amount) is
|
begin
|
begin
|
A.Current_Balance := A.Current_Balance + X;
|
A.Current_Balance := A.Current_Balance + X;
|
end Deposit;
|
end Deposit;
|
|
|
procedure Withdrawal(A : in out Account;
|
procedure Withdrawal(A : in out Account;
|
X : in Dollar_Amount) is
|
X : in Dollar_Amount) is
|
begin
|
begin
|
A.Current_Balance := A.Current_Balance - X;
|
A.Current_Balance := A.Current_Balance - X;
|
end Withdrawal;
|
end Withdrawal;
|
|
|
function Balance (A : in Account) return Dollar_Amount is
|
function Balance (A : in Account) return Dollar_Amount is
|
begin
|
begin
|
return (A.Current_Balance);
|
return (A.Current_Balance);
|
end Balance;
|
end Balance;
|
|
|
procedure Service_Charge (A : in out Account) is
|
procedure Service_Charge (A : in out Account) is
|
begin
|
begin
|
A.Current_Balance := A.Current_Balance - 5_00;
|
A.Current_Balance := A.Current_Balance - 5_00;
|
end Service_Charge;
|
end Service_Charge;
|
|
|
procedure Add_Interest (A : in out Account) is
|
procedure Add_Interest (A : in out Account) is
|
Interest_On_Account : Dollar_Amount := 0_00;
|
Interest_On_Account : Dollar_Amount := 0_00;
|
begin
|
begin
|
A.Current_Balance := A.Current_Balance + Interest_On_Account;
|
A.Current_Balance := A.Current_Balance + Interest_On_Account;
|
end Add_Interest;
|
end Add_Interest;
|
|
|
procedure Open (A : in out Account) is
|
procedure Open (A : in out Account) is
|
Initial_Deposit : Dollar_Amount := 10_00;
|
Initial_Deposit : Dollar_Amount := 10_00;
|
begin
|
begin
|
A.Current_Balance := Initial_Deposit;
|
A.Current_Balance := Initial_Deposit;
|
end Open;
|
end Open;
|
|
|
end C392008_0;
|
end C392008_0;
|
|
|
----------------------------------------------------------------- C392008_1
|
----------------------------------------------------------------- C392008_1
|
|
|
with C392008_0; -- package Bank
|
with C392008_0; -- package Bank
|
|
|
package C392008_1 is -- package Checking
|
package C392008_1 is -- package Checking
|
|
|
package Bank renames C392008_0;
|
package Bank renames C392008_0;
|
|
|
type Account is new Bank.Account with
|
type Account is new Bank.Account with
|
record
|
record
|
Overdraft_Fee : Bank.Dollar_Amount;
|
Overdraft_Fee : Bank.Dollar_Amount;
|
end record;
|
end record;
|
|
|
-- Overridden primitive operation.
|
-- Overridden primitive operation.
|
|
|
procedure Open (A : in out Account);
|
procedure Open (A : in out Account);
|
|
|
-- Inherited primitive operations.
|
-- Inherited primitive operations.
|
-- procedure Deposit (A : in out Account;
|
-- procedure Deposit (A : in out Account;
|
-- X : in Bank.Dollar_Amount);
|
-- X : in Bank.Dollar_Amount);
|
-- procedure Withdrawal (A : in out Account;
|
-- procedure Withdrawal (A : in out Account;
|
-- X : in Bank.Dollar_Amount);
|
-- X : in Bank.Dollar_Amount);
|
-- function Balance (A : in Account) return Bank.Dollar_Amount;
|
-- function Balance (A : in Account) return Bank.Dollar_Amount;
|
-- procedure Service_Charge (A : in out Account);
|
-- procedure Service_Charge (A : in out Account);
|
-- procedure Add_Interest (A : in out Account);
|
-- procedure Add_Interest (A : in out Account);
|
|
|
end C392008_1;
|
end C392008_1;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
package body C392008_1 is
|
package body C392008_1 is
|
|
|
-- Overridden primitive operation.
|
-- Overridden primitive operation.
|
|
|
procedure Open (A : in out Account) is
|
procedure Open (A : in out Account) is
|
Check_Guarantee : Bank.Dollar_Amount := 10_00;
|
Check_Guarantee : Bank.Dollar_Amount := 10_00;
|
Initial_Deposit : Bank.Dollar_Amount := 20_00;
|
Initial_Deposit : Bank.Dollar_Amount := 20_00;
|
begin
|
begin
|
A.Current_Balance := Initial_Deposit;
|
A.Current_Balance := Initial_Deposit;
|
A.Overdraft_Fee := Check_Guarantee;
|
A.Overdraft_Fee := Check_Guarantee;
|
end Open;
|
end Open;
|
|
|
end C392008_1;
|
end C392008_1;
|
|
|
----------------------------------------------------------------- C392008_2
|
----------------------------------------------------------------- C392008_2
|
|
|
with C392008_0; -- with Bank;
|
with C392008_0; -- with Bank;
|
with C392008_1; -- with Checking;
|
with C392008_1; -- with Checking;
|
|
|
package C392008_2 is -- package Interest_Checking
|
package C392008_2 is -- package Interest_Checking
|
|
|
package Bank renames C392008_0;
|
package Bank renames C392008_0;
|
package Checking renames C392008_1;
|
package Checking renames C392008_1;
|
|
|
subtype Interest_Rate is Bank.Dollar_Amount range 0..100; -- was digits 4;
|
subtype Interest_Rate is Bank.Dollar_Amount range 0..100; -- was digits 4;
|
|
|
Current_Rate : Interest_Rate := 0_02;
|
Current_Rate : Interest_Rate := 0_02;
|
|
|
type Account is new Checking.Account with
|
type Account is new Checking.Account with
|
record
|
record
|
Rate : Interest_Rate;
|
Rate : Interest_Rate;
|
end record;
|
end record;
|
|
|
-- Overridden primitive operations.
|
-- Overridden primitive operations.
|
|
|
procedure Add_Interest (A : in out Account);
|
procedure Add_Interest (A : in out Account);
|
procedure Open (A : in out Account);
|
procedure Open (A : in out Account);
|
|
|
-- "Twice" inherited primitive operations (from Bank.Account)
|
-- "Twice" inherited primitive operations (from Bank.Account)
|
-- procedure Deposit (A : in out Account;
|
-- procedure Deposit (A : in out Account;
|
-- X : in Bank.Dollar_Amount);
|
-- X : in Bank.Dollar_Amount);
|
-- procedure Withdrawal (A : in out Account;
|
-- procedure Withdrawal (A : in out Account;
|
-- X : in Bank.Dollar_Amount);
|
-- X : in Bank.Dollar_Amount);
|
-- function Balance (A : in Account) return Bank.Dollar_Amount;
|
-- function Balance (A : in Account) return Bank.Dollar_Amount;
|
-- procedure Service_Charge (A : in out Account);
|
-- procedure Service_Charge (A : in out Account);
|
|
|
end C392008_2;
|
end C392008_2;
|
|
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
package body C392008_2 is
|
package body C392008_2 is
|
|
|
-- Overridden primitive operations.
|
-- Overridden primitive operations.
|
|
|
procedure Add_Interest (A : in out Account) is
|
procedure Add_Interest (A : in out Account) is
|
Interest_On_Account : Bank.Dollar_Amount
|
Interest_On_Account : Bank.Dollar_Amount
|
:= Bank.Dollar_Amount( Bank."*"( A.Current_Balance, A.Rate ));
|
:= Bank.Dollar_Amount( Bank."*"( A.Current_Balance, A.Rate ));
|
begin
|
begin
|
A.Current_Balance := Bank."+"( A.Current_Balance, Interest_On_Account);
|
A.Current_Balance := Bank."+"( A.Current_Balance, Interest_On_Account);
|
end Add_Interest;
|
end Add_Interest;
|
|
|
procedure Open (A : in out Account) is
|
procedure Open (A : in out Account) is
|
Initial_Deposit : Bank.Dollar_Amount := 30_00;
|
Initial_Deposit : Bank.Dollar_Amount := 30_00;
|
begin
|
begin
|
Checking.Open (Checking.Account (A));
|
Checking.Open (Checking.Account (A));
|
A.Current_Balance := Initial_Deposit;
|
A.Current_Balance := Initial_Deposit;
|
A.Rate := Current_Rate;
|
A.Rate := Current_Rate;
|
end Open;
|
end Open;
|
|
|
end C392008_2;
|
end C392008_2;
|
|
|
------------------------------------------------------------------- C392008
|
------------------------------------------------------------------- C392008
|
|
|
with C392008_0; use C392008_0; -- package Bank
|
with C392008_0; use C392008_0; -- package Bank
|
with C392008_1; use C392008_1; -- package Checking;
|
with C392008_1; use C392008_1; -- package Checking;
|
with C392008_2; use C392008_2; -- package Interest_Checking;
|
with C392008_2; use C392008_2; -- package Interest_Checking;
|
with Report;
|
with Report;
|
|
|
procedure C392008 is
|
procedure C392008 is
|
|
|
package Bank renames C392008_0;
|
package Bank renames C392008_0;
|
package Checking renames C392008_1;
|
package Checking renames C392008_1;
|
package Interest_Checking renames C392008_2;
|
package Interest_Checking renames C392008_2;
|
|
|
B_Acct : Bank.Account;
|
B_Acct : Bank.Account;
|
C_Acct : Checking.Account;
|
C_Acct : Checking.Account;
|
IC_Acct : Interest_Checking.Account;
|
IC_Acct : Interest_Checking.Account;
|
|
|
--
|
--
|
-- Define procedures with class-wide formal parameters of mode IN OUT.
|
-- Define procedures with class-wide formal parameters of mode IN OUT.
|
--
|
--
|
|
|
-- This procedure will perform a dispatching call on the
|
-- This procedure will perform a dispatching call on the
|
-- overridden primitive operation Open.
|
-- overridden primitive operation Open.
|
|
|
procedure New_Account (Acct : in out Bank.Account'Class) is
|
procedure New_Account (Acct : in out Bank.Account'Class) is
|
begin
|
begin
|
Open (Acct); -- Dispatch according to tag of class-wide parameter.
|
Open (Acct); -- Dispatch according to tag of class-wide parameter.
|
end New_Account;
|
end New_Account;
|
|
|
-- This procedure will perform a dispatching call on the inherited
|
-- This procedure will perform a dispatching call on the inherited
|
-- primitive operation (for all types derived from the root Bank.Account)
|
-- primitive operation (for all types derived from the root Bank.Account)
|
-- Service_Charge.
|
-- Service_Charge.
|
|
|
procedure Apply_Service_Charge (Acct: in out Bank.Account'Class) is
|
procedure Apply_Service_Charge (Acct: in out Bank.Account'Class) is
|
begin
|
begin
|
Service_Charge (Acct); -- Dispatch according to tag of class-wide parm.
|
Service_Charge (Acct); -- Dispatch according to tag of class-wide parm.
|
end Apply_Service_Charge;
|
end Apply_Service_Charge;
|
|
|
-- This procedure will perform a dispatching call on the
|
-- This procedure will perform a dispatching call on the
|
-- inherited/overridden primitive operation Add_Interest.
|
-- inherited/overridden primitive operation Add_Interest.
|
|
|
procedure Annual_Interest (Acct: in out Bank.Account'Class) is
|
procedure Annual_Interest (Acct: in out Bank.Account'Class) is
|
begin
|
begin
|
Add_Interest (Acct); -- Dispatch according to tag of class-wide parm.
|
Add_Interest (Acct); -- Dispatch according to tag of class-wide parm.
|
end Annual_Interest;
|
end Annual_Interest;
|
|
|
begin
|
begin
|
|
|
Report.Test ("C392008", "Check that the use of a class-wide formal " &
|
Report.Test ("C392008", "Check that the use of a class-wide formal " &
|
"parameter allows for the proper dispatching " &
|
"parameter allows for the proper dispatching " &
|
"of objects to the appropriate implementation " &
|
"of objects to the appropriate implementation " &
|
"of a primitive operation");
|
"of a primitive operation");
|
|
|
-- Check the dispatch to primitive operations overridden for each
|
-- Check the dispatch to primitive operations overridden for each
|
-- extended type.
|
-- extended type.
|
New_Account (B_Acct);
|
New_Account (B_Acct);
|
New_Account (C_Acct);
|
New_Account (C_Acct);
|
New_Account (IC_Acct);
|
New_Account (IC_Acct);
|
|
|
if (B_Acct.Current_Balance /= 10_00) or
|
if (B_Acct.Current_Balance /= 10_00) or
|
(C_Acct.Current_Balance /= 20_00) or
|
(C_Acct.Current_Balance /= 20_00) or
|
(IC_Acct.Current_Balance /= 30_00)
|
(IC_Acct.Current_Balance /= 30_00)
|
then
|
then
|
Report.Failed ("Failed dispatch to multiply overridden prim. oper.");
|
Report.Failed ("Failed dispatch to multiply overridden prim. oper.");
|
end if;
|
end if;
|
|
|
|
|
Annual_Interest (B_Acct);
|
Annual_Interest (B_Acct);
|
Annual_Interest (C_Acct);
|
Annual_Interest (C_Acct);
|
Annual_Interest (IC_Acct); -- Check the dispatch to primitive operation
|
Annual_Interest (IC_Acct); -- Check the dispatch to primitive operation
|
-- overridden from a parent type which inherited
|
-- overridden from a parent type which inherited
|
-- the operation from the root type.
|
-- the operation from the root type.
|
if (B_Acct.Current_Balance /= 10_00) or
|
if (B_Acct.Current_Balance /= 10_00) or
|
(C_Acct.Current_Balance /= 20_00) or
|
(C_Acct.Current_Balance /= 20_00) or
|
(IC_Acct.Current_Balance /= 90_00)
|
(IC_Acct.Current_Balance /= 90_00)
|
then
|
then
|
Report.Failed ("Failed dispatch to overridden primitive operation");
|
Report.Failed ("Failed dispatch to overridden primitive operation");
|
end if;
|
end if;
|
|
|
|
|
Apply_Service_Charge (Acct => B_Acct);
|
Apply_Service_Charge (Acct => B_Acct);
|
Apply_Service_Charge (Acct => C_Acct);
|
Apply_Service_Charge (Acct => C_Acct);
|
Apply_Service_Charge (Acct => IC_Acct); -- Check the dispatch to a
|
Apply_Service_Charge (Acct => IC_Acct); -- Check the dispatch to a
|
-- primitive operation twice
|
-- primitive operation twice
|
-- inherited from the root
|
-- inherited from the root
|
-- tagged type.
|
-- tagged type.
|
if (B_Acct.Current_Balance /= 5_00) or
|
if (B_Acct.Current_Balance /= 5_00) or
|
(C_Acct.Current_Balance /= 15_00) or
|
(C_Acct.Current_Balance /= 15_00) or
|
(IC_Acct.Current_Balance /= 85_00)
|
(IC_Acct.Current_Balance /= 85_00)
|
then
|
then
|
Report.Failed ("Failed dispatch to Apply_Service_Charge");
|
Report.Failed ("Failed dispatch to Apply_Service_Charge");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C392008;
|
end C392008;
|
|
|
