URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [ada/] [acats/] [support/] [f392a00.a] - Rev 294
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log