1-- C953001.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-- OBJECTIVE: 27-- Check that if the evaluation of an entry_barrier condition 28-- propagates an exception, the exception Program_Error 29-- is propagated to all current callers of all entries of the 30-- protected object. 31-- 32-- TEST DESCRIPTION: 33-- This test declares a protected object (PO) with two entries and 34-- a 5 element entry family. 35-- All the entries are always closed. However, one of the entries 36-- (Oh_No) will get a constraint_error in its barrier_evaluation 37-- whenever the global variable Blow_Up is true. 38-- An array of tasks is created where the tasks wait on the various 39-- entries of the protected object. Once all the tasks are waiting 40-- the main procedure calls the entry Oh_No and causes an exception 41-- to be propagated to all the tasks. The tasks record the fact 42-- that they got the correct exception in global variables that 43-- can be checked after the tasks complete. 44-- 45-- 46-- CHANGE HISTORY: 47-- 19 OCT 95 SAIC ACVC 2.1 48-- 49--! 50 51 52with Report; 53with ImpDef; 54procedure C953001 is 55 Verbose : constant Boolean := False; 56 Max_Tasks : constant := 12; 57 58 -- note status and error conditions 59 Blocked_Entry_Taken : Boolean := False; 60 In_Oh_No : Boolean := False; 61 Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False); 62 63begin 64 Report.Test ("C953001", 65 "Check that an exception in an entry_barrier condition" & 66 " causes Program_Error to be propagated to all current" & 67 " callers of all entries of the protected object"); 68 69 declare -- test encapsulation 70 -- miscellaneous values 71 Cows : Integer := Report.Ident_Int (1); 72 Came_Home : Integer := Report.Ident_Int (2); 73 74 -- make the Barrier_Condition fail only when we want it to 75 Blow_Up : Boolean := False; 76 77 function Barrier_Condition return Boolean is 78 begin 79 if Blow_Up then 80 return 5 mod Report.Ident_Int(0) = 1; 81 else 82 return False; 83 end if; 84 end Barrier_Condition; 85 86 subtype Family_Index is Integer range 1..5; 87 88 protected PO is 89 entry Block1; 90 entry Oh_No; 91 entry Family (Family_Index); 92 end PO; 93 94 protected body PO is 95 entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is 96 begin 97 Blocked_Entry_Taken := True; 98 end Block1; 99 100 -- barrier will get a Constraint_Error (divide by 0) 101 entry Oh_No when Barrier_Condition is 102 begin 103 In_Oh_No := True; 104 end Oh_No; 105 106 entry Family (for Member in Family_Index) when Cows = Came_Home is 107 begin 108 Blocked_Entry_Taken := True; 109 end Family; 110 end PO; 111 112 113 task type Waiter is 114 entry Take_Id (Id : Integer); 115 end Waiter; 116 117 Bunch_of_Waiters : array (1..Max_Tasks) of Waiter; 118 119 task body Waiter is 120 Me : Integer; 121 Action : Integer; 122 begin 123 accept Take_Id (Id : Integer) do 124 Me := Id; 125 end Take_Id; 126 127 Action := Me mod (Family_Index'Last + 1); 128 begin 129 if Action = 0 then 130 PO.Block1; 131 else 132 PO.Family (Action); 133 end if; 134 Report.Failed ("no exception for task" & Integer'Image (Me)); 135 exception 136 when Program_Error => 137 Task_Passed (Me) := True; 138 if Verbose then 139 Report.Comment ("pass for task" & Integer'Image (Me)); 140 end if; 141 when others => 142 Report.Failed ("wrong exception raised in task" & 143 Integer'Image (Me)); 144 end; 145 end Waiter; 146 147 148 begin -- test encapsulation 149 for I in 1..Max_Tasks loop 150 Bunch_Of_Waiters(I).Take_Id (I); 151 end loop; 152 153 -- give all the Waiters time to get queued 154 delay 2*ImpDef.Clear_Ready_Queue; 155 156 -- cause the protected object to fail 157 begin 158 Blow_Up := True; 159 PO.Oh_No; 160 Report.Failed ("no exception in call to PO.Oh_No"); 161 exception 162 when Constraint_Error => 163 Report.Failed ("Constraint_Error instead of Program_Error"); 164 when Program_Error => 165 if Verbose then 166 Report.Comment ("main exception passed"); 167 end if; 168 when others => 169 Report.Failed ("wrong exception in main"); 170 end; 171 end; -- test encapsulation 172 173 -- all the tasks have now completed. 174 -- check the flags for pass/fail info 175 if Blocked_Entry_Taken then 176 Report.Failed ("blocked entry taken"); 177 end if; 178 if In_Oh_No then 179 Report.Failed ("entry taken with exception in barrier"); 180 end if; 181 for I in 1..Max_Tasks loop 182 if not Task_Passed (I) then 183 Report.Failed ("task" & Integer'Image (I) & " did not pass"); 184 end if; 185 end loop; 186 187 Report.Result; 188end C953001; 189