Subversion Repositories openrisc

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

--*

--

-- TEST OBJECTIVE:

--      Check that the component_declarations of a protected_operation

--      are elaborated in the proper order.

--

-- TEST DESCRIPTION:

--      A discriminated protected object is declared with some

--      components that depend upon the discriminant and some that

--      do not depend upon the discriminant.  All the components

--      are initialized with a function call.  As a side-effect of

--      the function call the parameter passed to the function is

--      recorded in an elaboration order array.

--      Two objects of the protected type are declared.  The

--      elaboration order is recorded and checked against the

--      expected order.

--

--

-- CHANGE HISTORY:

--      09 Jan 96   SAIC    Initial Version for 2.1

--      09 Jul 96   SAIC    Addressed reviewer comments.

--      13 Feb 97   PWB.CTA Removed doomed attempt to check per-object

--                          constraint elaborations.

--!

with Report;

procedure C940015 is

    Verbose : constant Boolean := False;

    Do_Display : Boolean := Verbose;

    type Index is range 0..10;

    type List is array (1..10) of Integer;

    Last : Natural range 0 .. List'Last := 0;

    E_List : List := (others => 0);

    function Elaborate (Id : Integer) return Index is

    begin

        Last := Last + 1;

        E_List (Last) := Id;

        if Verbose then

            Report.Comment ("Elaborating" & Integer'Image (Id));

        end if;

        return Index(Id mod 10);

    end Elaborate;

    function Elaborate (Id, Per_Obj_Expr : Integer) return Index is

    begin

        return Elaborate (Id);

    end Elaborate;

begin

    Report.Test ("C940015", "Check that the component_declarations of a" &

                            " protected object are elaborated in the" &

                            " proper order");

    declare

        -- an unprotected queue type

        type Storage is array (Index range <>) of Integer;

        type Queue (Size, Flag : Index := 1) is

            record

                Head : Index := 1;

                Tail : Index := 1;

                Count : Index := 0;

                Buffer : Storage (1..Size);

            end record;

        -- protected group of queues type

        protected type Prot_Queues (Size : Index := Elaborate (104)) is

            procedure Clear;

            -- other needed procedures not provided at this time

        private

               -- elaborate at type elaboration

            Fixed_Queue_1    : Queue (3,

                                      Elaborate (105));

               -- elaborate at type elaboration

            Fixed_Queue_2    : Queue (6,

                                      Elaborate (107));

        end Prot_Queues;

        protected body Prot_Queues is

            procedure Clear is

            begin

                Fixed_Queue_1.Count := 0;

                Fixed_Queue_1.Head := 1;

                Fixed_Queue_1.Tail := 1;

                Fixed_Queue_2.Count := 0;

                Fixed_Queue_2.Head := 1;

                Fixed_Queue_2.Tail := 1;

            end Clear;

        end Prot_Queues;

        PO1 : Prot_Queues(9);

        PO2 : Prot_Queues;

        Expected_Elab_Order : List := (

           -- from the elaboration of the protected type Prot_Queues

           105, 107,

           -- from the unconstrained object PO2

           104,

           others => 0);

    begin

        for I in List'Range loop

            if E_List (I) /= Expected_Elab_Order (I) then

                Report.Failed ("wrong elaboration order");

                Do_Display := True;

            end if;

        end loop;

        if Do_Display then

            Report.Comment ("Expected  Actual");

            for I in List'Range loop

                Report.Comment (

                   Integer'Image (Expected_Elab_Order(I)) &

                   Integer'Image (E_List(I)));

            end loop;

        end if;

        -- make use of the protected objects

        PO1.Clear;

        PO2.Clear;

    end;

    Report.Result;

end C940015;