-- F392A00.A -- -- Grant of Unlimited Rights -- -- 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 -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- 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 -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- FOUNDATION DESCRIPTION: -- This foundation provides a basis for tests needing a hierarchy of -- types to check object-oriented features. -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- --! package F392A00 is -- package Accounts -- -- Types and subtypes. -- type Dollar_Amount is new Float; type Interest_Rate is delta 0.001 range 0.000 .. 1.000; type Account_Types is (Bank, Savings, Preferred, Total); type Account_Counter is array (Account_Types) of Integer; type Account_Rep is (President, Manager, New_Account_Manager, Teller); -- -- Constants. -- Opening_Balance : constant Dollar_Amount := 100.00; Current_Rate : constant Interest_Rate := 0.030; Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00; -- -- Global Variables -- Bank_Reserve : Dollar_Amount := 0.00; Daily_Representative : Account_Rep := New_Account_Manager; Number_Of_Accounts : Account_Counter := (Bank => 0, Savings => 0, Preferred => 0, Total => 0); -- -- Account types and their primitive operations. -- -- Root type. type Bank_Account is tagged record Balance : Dollar_Amount; end record; -- Primitive operations of Bank_Account. procedure Increment_Bank_Reserve (Acct : in Bank_Account); procedure Assign_Representative (Acct : in Bank_Account); procedure Increment_Counters (Acct : in Bank_Account); procedure Open (Acct : in out Bank_Account); -- type Savings_Account is new Bank_Account with record Rate : Interest_Rate; end record; -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account). -- Primitive operations (Overridden). procedure Assign_Representative (Acct : in Savings_Account); procedure Increment_Counters (Acct : in Savings_Account); procedure Open (Acct : in out Savings_Account); -- type Preferred_Account is new Savings_Account with record Minimum_Balance : Dollar_Amount; end record; -- Procedure Increment_Bank_Reserve inherited twice. -- Procedure Assign_Representative inherited from parent (Savings_Account). -- Primitive operations (Overridden). procedure Increment_Counters (Acct : in Preferred_Account); procedure Open (Acct : in out Preferred_Account); -- Function used to verify Open operation for Preferred_Account objects. function Verify_Open (Acct : in Preferred_Account) return Boolean; end F392A00; --=================================================================-- package body F392A00 is -- -- Primitive operations for Bank_Account. -- procedure Increment_Bank_Reserve (Acct : in Bank_Account) is begin Bank_Reserve := Bank_Reserve + Acct.Balance; end Increment_Bank_Reserve; procedure Assign_Representative (Acct : in Bank_Account) is begin Daily_Representative := Teller; end Assign_Representative; procedure Increment_Counters (Acct : in Bank_Account) is begin Number_Of_Accounts (Bank) := Number_Of_Accounts (Bank) + 1; Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; end Increment_Counters; procedure Open (Acct : in out Bank_Account) is begin Acct.Balance := Opening_Balance; end Open; -- -- Overridden operations for Savings_Account type. -- procedure Assign_Representative (Acct : in Savings_Account) is begin Daily_Representative := Manager; end Assign_Representative; procedure Increment_Counters (Acct : in Savings_Account) is begin Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1; Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; end Increment_Counters; procedure Open (Acct : in out Savings_Account) is begin Open (Bank_Account(Acct)); Acct.Rate := Current_Rate; Acct.Balance := 2.0 * Opening_Balance; end Open; -- -- Overridden operation for Preferred_Account type. -- procedure Increment_Counters (Acct : in Preferred_Account) is begin Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1; Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1; end Increment_Counters; procedure Open (Acct : in out Preferred_Account) is begin Open (Savings_Account(Acct)); Acct.Minimum_Balance := Preferred_Minimum_Balance; Acct.Balance := Acct.Minimum_Balance; end Open; -- -- Function used to verify Open operation for Preferred_Account objects. -- function Verify_Open (Acct : in Preferred_Account) return Boolean is begin return (Acct.Balance = Preferred_Minimum_Balance and Acct.Rate = Current_Rate and Acct.Minimum_Balance = Preferred_Minimum_Balance); end Verify_Open; end F392A00;