-- 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;