Subversion Repositories openrisc

-- C341A03.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.

--*

--

-- OBJECTIVE:

--      Check that an object of one class-wide type can initialize a

--      class-wide object of a different type when the operation is embedded

--      in a generic unit.

--

-- TEST DESCRIPTION:

--      Declare specific-type objects of an extended type.  Declare an array

--      of access values designating class-wide objects, initialized to point

--      to the objects of the specific type.  Define a generic subprogram

--      having a generic formal derived type parameter.  Within the generic,

--      declare a class-wide variable of the formal parameter type.  Verify

--      that the variable can be initialized with the value of an object

--      of another class-wide type within the class.

--

--      The particular root and extended types used in this abstraction are

--      defined in foundation code (F341A00.A), and are graphically displayed

--      as follows:

--

--           package Bank

--              type Account

--                  |

--                  |

--                  |

--               package Checking

--                  type Account

--                      |

--                      |

--                      |

--                   package Interest_Checking

--                          type Account

--

-- TEST FILES:

--      This test depends on the following foundation code:

--

--         F341A00.A

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--      16 Dec 94   SAIC    Changed level of 'Class for ATM_Card

--

--!

with F341A00_0;            -- package Bank

generic

   type Account_Type is new F341A00_0.Account with private; -- new Bank.Account

function C341A03_0 (The_Account : Account_Type'Class)       -- function Audit

  return F341A00_0.Dollar_Amount;

function C341A03_0 (The_Account : Account_Type'Class)

  return F341A00_0.Dollar_Amount is

   Acct : Account_Type'Class := The_Account;  -- Init. of class-wide with

begin                                         -- another class-wide object.

   return Acct.Current_Balance;

end C341A03_0;

     --=================================================================--

with F341A00_0;            -- package Bank

with F341A00_1;            -- package Checking

with C341A03_0;            -- generic function Audit

with Report;

procedure C341A03 is

   package Bank     renames F341A00_0;

   package Checking renames F341A00_1;

   Current_Checking_Accounts : constant := 3;

   Checking_Acct1 : aliased Checking.Account := (Current_Balance => 10.00,

                                                 Overdraft_Fee   =>  5.00);

   Checking_Acct2 : aliased Checking.Account := (Current_Balance => 20.00,

                                                 Overdraft_Fee   =>  5.00);

   Checking_Acct3 : aliased Checking.Account := (Current_Balance => 30.00,

                                                 Overdraft_Fee   =>  5.00);

   type ATM_Card is access all Checking.Account'Class;

   -- Declare array of accesses to class-wide objects.

   Account_Array : array (1 .. Current_Checking_Accounts) of

     ATM_Card := (Checking_Acct1'Access,

                  Checking_Acct2'Access,

                  Checking_Acct3'Access);

begin  -- C341A03

   Report.Test ("C341A03",  "Check that an object of one class-wide type " &

                            "can initialize a class-wide object of a "   &

                            "different type when the operation is embedded " &

                            "in a generic unit" );

   Audit_Checking_Accounts:

   declare

      Balance_In_Checking_Accounts : Bank.Dollar_Amount := 0.00;

      -- Instantiate with a specific extended type.

      function Checking_Audit is new C341A03_0 (Checking.Account);

      use type Bank.Dollar_Amount;

   begin

      for I in 1 .. Current_Checking_Accounts loop

         Balance_In_Checking_Accounts := Balance_In_Checking_Accounts +

           Checking_Audit (Account_Array (I).all);

      end loop;

      if Balance_In_Checking_Accounts /= 60.00 then

         Report.Failed ("Incorrect initialization of class-wide object");

      end if;

   end Audit_Checking_Accounts;

   Report.Result;

end C341A03;