1-- C940015.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-- TEST OBJECTIVE: 27-- Check that the component_declarations of a protected_operation 28-- are elaborated in the proper order. 29-- 30-- TEST DESCRIPTION: 31-- A discriminated protected object is declared with some 32-- components that depend upon the discriminant and some that 33-- do not depend upon the discriminant. All the components 34-- are initialized with a function call. As a side-effect of 35-- the function call the parameter passed to the function is 36-- recorded in an elaboration order array. 37-- Two objects of the protected type are declared. The 38-- elaboration order is recorded and checked against the 39-- expected order. 40-- 41-- 42-- CHANGE HISTORY: 43-- 09 Jan 96 SAIC Initial Version for 2.1 44-- 09 Jul 96 SAIC Addressed reviewer comments. 45-- 13 Feb 97 PWB.CTA Removed doomed attempt to check per-object 46-- constraint elaborations. 47--! 48 49 50with Report; 51 52procedure C940015 is 53 Verbose : constant Boolean := False; 54 Do_Display : Boolean := Verbose; 55 56 type Index is range 0..10; 57 58 type List is array (1..10) of Integer; 59 Last : Natural range 0 .. List'Last := 0; 60 E_List : List := (others => 0); 61 62 function Elaborate (Id : Integer) return Index is 63 begin 64 Last := Last + 1; 65 E_List (Last) := Id; 66 if Verbose then 67 Report.Comment ("Elaborating" & Integer'Image (Id)); 68 end if; 69 return Index(Id mod 10); 70 end Elaborate; 71 72 function Elaborate (Id, Per_Obj_Expr : Integer) return Index is 73 begin 74 return Elaborate (Id); 75 end Elaborate; 76 77begin 78 79 Report.Test ("C940015", "Check that the component_declarations of a" & 80 " protected object are elaborated in the" & 81 " proper order"); 82 declare 83 -- an unprotected queue type 84 type Storage is array (Index range <>) of Integer; 85 type Queue (Size, Flag : Index := 1) is 86 record 87 Head : Index := 1; 88 Tail : Index := 1; 89 Count : Index := 0; 90 Buffer : Storage (1..Size); 91 end record; 92 93 -- protected group of queues type 94 protected type Prot_Queues (Size : Index := Elaborate (104)) is 95 procedure Clear; 96 -- other needed procedures not provided at this time 97 private 98 -- elaborate at type elaboration 99 Fixed_Queue_1 : Queue (3, 100 Elaborate (105)); 101 -- elaborate at type elaboration 102 Fixed_Queue_2 : Queue (6, 103 Elaborate (107)); 104 end Prot_Queues; 105 protected body Prot_Queues is 106 procedure Clear is 107 begin 108 Fixed_Queue_1.Count := 0; 109 Fixed_Queue_1.Head := 1; 110 Fixed_Queue_1.Tail := 1; 111 Fixed_Queue_2.Count := 0; 112 Fixed_Queue_2.Head := 1; 113 Fixed_Queue_2.Tail := 1; 114 end Clear; 115 end Prot_Queues; 116 117 PO1 : Prot_Queues(9); 118 PO2 : Prot_Queues; 119 120 Expected_Elab_Order : List := ( 121 -- from the elaboration of the protected type Prot_Queues 122 105, 107, 123 -- from the unconstrained object PO2 124 104, 125 others => 0); 126 begin 127 for I in List'Range loop 128 if E_List (I) /= Expected_Elab_Order (I) then 129 Report.Failed ("wrong elaboration order"); 130 Do_Display := True; 131 end if; 132 end loop; 133 if Do_Display then 134 Report.Comment ("Expected Actual"); 135 for I in List'Range loop 136 Report.Comment ( 137 Integer'Image (Expected_Elab_Order(I)) & 138 Integer'Image (E_List(I))); 139 end loop; 140 end if; 141 142 -- make use of the protected objects 143 PO1.Clear; 144 PO2.Clear; 145 end; 146 147 Report.Result; 148 149end C940015; 150