gcc/testsuite/ada/acats/support/f392a00.a

   1 -- F392A00.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 -- FOUNDATION DESCRIPTION:
  27 --      This foundation provides a basis for tests needing a hierarchy of
  28 --      types to check object-oriented features.
  29 --
  30 -- CHANGE HISTORY:
  31 --      06 Dec 94   SAIC    ACVC 2.0
  32 --
  33 --!
  34
  35 package F392A00 is          -- package Accounts
  36
  37    --
  38    -- Types and subtypes.
  39    --
  40
  41    type Dollar_Amount  is new Float;
  42    type Interest_Rate  is delta 0.001 range 0.000 .. 1.000;
  43    type Account_Types  is (Bank, Savings, Preferred, Total);
  44    type Account_Counter is array (Account_Types) of Integer;
  45    type Account_Rep is (President, Manager, New_Account_Manager, Teller);
  46
  47    --
  48    -- Constants.
  49    --
  50
  51    Opening_Balance           : constant Dollar_Amount := 100.00;
  52    Current_Rate              : constant Interest_Rate := 0.030;
  53    Preferred_Minimum_Balance : constant Dollar_Amount := 1000.00;
  54
  55    --
  56    -- Global Variables
  57    --
  58
  59    Bank_Reserve         : Dollar_Amount   := 0.00;
  60    Daily_Representative : Account_Rep     := New_Account_Manager;
  61    Number_Of_Accounts   : Account_Counter := (Bank      => 0,
  62                                               Savings   => 0,
  63                                               Preferred => 0,
  64                                               Total     => 0);
  65    --
  66    -- Account types and their primitive operations.
  67    --
  68
  69    -- Root type.
  70
  71    type Bank_Account is tagged
  72       record
  73          Balance : Dollar_Amount;
  74       end record;
  75
  76    -- Primitive operations of Bank_Account.
  77
  78    procedure Increment_Bank_Reserve (Acct : in     Bank_Account);
  79    procedure Assign_Representative  (Acct : in     Bank_Account);
  80    procedure Increment_Counters     (Acct : in     Bank_Account);
  81    procedure Open                   (Acct : in out Bank_Account);
  82
  83    --
  84
  85    type Savings_Account is new Bank_Account with
  86       record
  87          Rate : Interest_Rate;
  88       end record;
  89
  90    -- Procedure Increment_Bank_Reserve inherited from parent (Bank_Account).
  91
  92    -- Primitive operations (Overridden).
  93    procedure Assign_Representative (Acct : in     Savings_Account);
  94    procedure Increment_Counters    (Acct : in     Savings_Account);
  95    procedure Open                  (Acct : in out Savings_Account);
  96
  97    --
  98
  99    type Preferred_Account is new Savings_Account with
 100       record
 101          Minimum_Balance : Dollar_Amount;
 102       end record;
 103
 104    -- Procedure Increment_Bank_Reserve inherited twice.
 105    -- Procedure Assign_Representative inherited from parent (Savings_Account).
 106
 107    -- Primitive operations (Overridden).
 108    procedure Increment_Counters (Acct : in     Preferred_Account);
 109    procedure Open               (Acct : in out Preferred_Account);
 110
 111    -- Function used to verify Open operation for Preferred_Account objects.
 112    function Verify_Open (Acct : in Preferred_Account) return Boolean;
 113
 114
 115 end F392A00;
 116
 117
 118      --=================================================================--
 119
 120
 121 package body F392A00 is
 122
 123    --
 124    -- Primitive operations for Bank_Account.
 125    --
 126
 127    procedure Increment_Bank_Reserve (Acct : in Bank_Account) is
 128    begin
 129       Bank_Reserve := Bank_Reserve + Acct.Balance;
 130    end Increment_Bank_Reserve;
 131
 132    procedure Assign_Representative (Acct : in Bank_Account) is
 133    begin
 134       Daily_Representative := Teller;
 135    end Assign_Representative;
 136
 137    procedure Increment_Counters (Acct : in Bank_Account) is
 138    begin
 139       Number_Of_Accounts (Bank)  := Number_Of_Accounts (Bank) + 1;
 140       Number_Of_Accounts (Total) := Number_Of_Accounts (Total) + 1;
 141    end Increment_Counters;
 142
 143    procedure Open (Acct : in out Bank_Account) is
 144    begin
 145       Acct.Balance := Opening_Balance;
 146    end Open;
 147
 148
 149    --
 150    -- Overridden operations for Savings_Account type.
 151    --
 152
 153    procedure Assign_Representative (Acct : in Savings_Account) is
 154    begin
 155       Daily_Representative := Manager;
 156    end Assign_Representative;
 157
 158    procedure Increment_Counters (Acct : in Savings_Account) is
 159    begin
 160       Number_Of_Accounts (Savings) := Number_Of_Accounts (Savings) + 1;
 161       Number_Of_Accounts (Total)   := Number_Of_Accounts (Total) + 1;
 162    end Increment_Counters;
 163
 164    procedure Open (Acct : in out Savings_Account) is
 165    begin
 166       Open (Bank_Account(Acct));
 167       Acct.Rate := Current_Rate;
 168       Acct.Balance := 2.0 * Opening_Balance;
 169    end Open;
 170
 171
 172    --
 173    -- Overridden operation for Preferred_Account type.
 174    --
 175
 176    procedure Increment_Counters (Acct : in Preferred_Account) is
 177    begin
 178       Number_Of_Accounts (Preferred) := Number_Of_Accounts (Preferred) + 1;
 179       Number_Of_Accounts (Total)     := Number_Of_Accounts (Total) + 1;
 180    end Increment_Counters;
 181
 182    procedure Open (Acct : in out Preferred_Account) is
 183    begin
 184       Open (Savings_Account(Acct));
 185       Acct.Minimum_Balance := Preferred_Minimum_Balance;
 186       Acct.Balance := Acct.Minimum_Balance;
 187    end Open;
 188
 189    --
 190    -- Function used to verify Open operation for Preferred_Account objects.
 191    --
 192
 193    function Verify_Open (Acct : in Preferred_Account) return Boolean is
 194    begin
 195       return (Acct.Balance         = Preferred_Minimum_Balance and
 196               Acct.Rate            = Current_Rate              and
 197               Acct.Minimum_Balance = Preferred_Minimum_Balance);
 198    end Verify_Open;
 199
 200 end F392A00;