1-- C951002.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 an entry and a procedure within the same protected object 28-- will not be executed simultaneously. 29-- 30-- TEST DESCRIPTION: 31-- Two tasks are used. The first calls an entry who's barrier is set 32-- and is thus queued. The second calls a procedure in the same 33-- protected object. This procedure clears the entry barrier of the 34-- first then executes a lengthy compute bound procedure. This is 35-- intended to allow a multiprocessor, or a time-slicing implementation 36-- of a uniprocessor, to (erroneously) permit the first task to continue 37-- while the second is still computing. Flags in each process in the 38-- PO are checked to ensure that they do not run out of sequence or in 39-- parallel. 40-- In the second part of the test another entry and procedure are used 41-- but in this case the procedure is started first. A different task 42-- calls the entry AFTER the procedure has started. If the entry 43-- completes before the procedure the test fails. 44-- 45-- This test will not be effective on a uniprocessor without time-slicing 46-- It is designed to increase the chances of failure on a multiprocessor, 47-- or a uniprocessor with time-slicing, if the entry and procedure in a 48-- Protected Object are not forced to acquire a single execution 49-- resource. It is not guaranteed to fail. 50-- 51-- 52-- CHANGE HISTORY: 53-- 06 Dec 94 SAIC ACVC 2.0 54-- 55--! 56 57with Report; 58with ImpDef; 59 60procedure C951002 is 61 62 -- These global error flags are used for failure conditions within 63 -- the protected object. We cannot call Report.Failed (thus Text_io) 64 -- which would result in a bounded error. 65 -- 66 TC_Error_01 : Boolean := false; 67 TC_Error_02 : Boolean := false; 68 TC_Error_03 : Boolean := false; 69 TC_Error_04 : Boolean := false; 70 TC_Error_05 : Boolean := false; 71 TC_Error_06 : Boolean := false; 72 73begin 74 75 Report.Test ("C951002", "Check that a procedure and an entry body " & 76 "in a protected object will not run concurrently"); 77 78 declare -- encapsulate the test 79 80 task Credit_Message is 81 entry TC_Start; 82 end Credit_Message; 83 84 task Credit_Task is 85 entry TC_Start; 86 end Credit_Task; 87 88 task Debit_Message is 89 entry TC_Start; 90 end Debit_Message; 91 92 task Debit_Task is 93 entry TC_Start; 94 end Debit_Task; 95 96 --==================================== 97 98 protected Hold is 99 100 entry Wait_for_CR_Underload; 101 procedure Clear_CR_Overload; 102 entry Wait_for_DB_Underload; 103 procedure Set_DB_Overload; 104 procedure Clear_DB_Overload; 105 -- 106 function TC_Message_is_Queued return Boolean; 107 108 private 109 Credit_Overloaded : Boolean := true; -- Test starts in overload 110 Debit_Overloaded : Boolean := false; 111 -- 112 TC_CR_Proc_Finished : Boolean := false; 113 TC_CR_Entry_Finished : Boolean := false; 114 TC_DB_Proc_Finished : Boolean := false; 115 TC_DB_Entry_Finished : Boolean := false; 116 end Hold; 117 --==================== 118 protected body Hold is 119 120 entry Wait_for_CR_Underload when not Credit_Overloaded is 121 begin 122 -- The barrier must only be re-evaluated at the end of the 123 -- of the execution of the procedure, also while the procedure 124 -- is executing this entry body must not be executed 125 if not TC_CR_Proc_Finished then 126 TC_Error_01 := true; -- Set error indicator 127 end if; 128 TC_CR_Entry_Finished := true; 129 end Wait_for_CR_Underload ; 130 131 -- This is the procedure which should NOT be able to run in 132 -- parallel with the entry body 133 -- 134 procedure Clear_CR_Overload is 135 begin 136 137 -- The entry body must not be executed until this procedure 138 -- is completed. 139 if TC_CR_Entry_Finished then 140 TC_Error_02 := true; -- Set error indicator 141 end if; 142 Credit_Overloaded := false; -- clear the entry barrier 143 144 -- Execute an implementation defined compute bound routine which 145 -- is designed to run long enough to allow a task switch on a 146 -- time-sliced uniprocessor, or for a multiprocessor to pick up 147 -- another task. 148 -- 149 ImpDef.Exceed_Time_Slice; 150 151 -- Again, the entry body must not be executed until the current 152 -- procedure is completed. 153 -- 154 if TC_CR_Entry_Finished then 155 TC_Error_03 := true; -- Set error indicator 156 end if; 157 TC_CR_Proc_Finished := true; 158 159 end Clear_CR_Overload; 160 161 --============ 162 -- The following subprogram and entry body are used in the second 163 -- part of the test 164 165 entry Wait_for_DB_Underload when not Debit_Overloaded is 166 begin 167 -- By the time the task that calls this entry is allowed access to 168 -- the queue the barrier, which starts off as open, will be closed 169 -- by the Set_DB_Overload procedure. It is only reopened 170 -- at the end of the test 171 if not TC_DB_Proc_Finished then 172 TC_Error_04 := true; -- Set error indicator 173 end if; 174 TC_DB_Entry_Finished := true; 175 end Wait_for_DB_Underload ; 176 177 178 procedure Set_DB_Overload is 179 begin 180 -- The task timing is such that this procedure should be started 181 -- before the entry is called. Thus the entry should be blocked 182 -- until the end of this procedure which then sets the barrier 183 -- 184 if TC_DB_Entry_Finished then 185 TC_Error_05 := true; -- Set error indicator 186 end if; 187 188 -- Execute an implementation defined compute bound routine which 189 -- is designed to run long enough to allow a task switch on a 190 -- time-sliced uniprocessor, or for a multiprocessor to pick up 191 -- another task 192 -- 193 ImpDef.Exceed_Time_Slice; 194 195 Debit_Overloaded := true; -- set the entry barrier 196 197 if TC_DB_Entry_Finished then 198 TC_Error_06 := true; -- Set error indicator 199 end if; 200 TC_DB_Proc_Finished := true; 201 202 end Set_DB_Overload; 203 204 procedure Clear_DB_Overload is 205 begin 206 Debit_Overloaded := false; -- open the entry barrier 207 end Clear_DB_Overload; 208 209 function TC_Message_is_Queued return Boolean is 210 begin 211 212 -- returns true when one message arrives on the queue 213 return (Wait_for_CR_Underload'Count = 1); 214 215 end TC_Message_is_Queued ; 216 217 end Hold; 218 219 --==================================== 220 221 task body Credit_Message is 222 begin 223 accept TC_Start; 224 --:: some application processing. Part of the process finds that 225 -- the Overload threshold has been exceeded for the Credit 226 -- application. This message task queues itself on a queue 227 -- waiting till the overload in no longer in effect 228 Hold.Wait_for_CR_Underload; 229 exception 230 when others => 231 Report.Failed ("Unexpected Exception in Credit_Message Task"); 232 end Credit_Message; 233 234 task body Credit_Task is 235 begin 236 accept TC_Start; 237 -- Application code here (not shown) determines that the 238 -- underload threshold has been reached 239 Hold.Clear_CR_Overload; 240 exception 241 when others => 242 Report.Failed ("Unexpected Exception in Credit_Task"); 243 end Credit_Task; 244 245 --============== 246 247 -- The following two tasks are used in the second part of the test 248 249 task body Debit_Message is 250 begin 251 accept TC_Start; 252 --:: some application processing. Part of the process finds that 253 -- the Overload threshold has been exceeded for the Debit 254 -- application. This message task queues itself on a queue 255 -- waiting till the overload is no longer in effect 256 -- 257 Hold.Wait_for_DB_Underload; 258 exception 259 when others => 260 Report.Failed ("Unexpected Exception in Debit_Message Task"); 261 end Debit_Message; 262 263 task body Debit_Task is 264 begin 265 accept TC_Start; 266 -- Application code here (not shown) determines that the 267 -- underload threshold has been reached 268 Hold.Set_DB_Overload; 269 exception 270 when others => 271 Report.Failed ("Unexpected Exception in Debit_Task"); 272 end Debit_Task; 273 274 begin -- declare 275 276 Credit_Message.TC_Start; 277 278 -- Wait until the message is queued on the entry before starting 279 -- the Credit_Task 280 while not Hold.TC_Message_is_Queued loop 281 delay ImpDef.Long_Minimum_Task_Switch; 282 end loop; 283 -- 284 Credit_Task.TC_Start; 285 286 -- Ensure the first part of the test is complete before continuing 287 while not (Credit_Message'terminated and Credit_Task'terminated) loop 288 delay ImpDef.Long_Minimum_Task_Switch; 289 end loop; 290 291 --====================================================== 292 -- Second part of the test 293 294 295 Debit_Task.TC_Start; 296 297 -- Delay long enough to allow a task switch to the Debit_Task and 298 -- for it to reach the accept statement and call Hold.Set_DB_Overload 299 -- before starting Debit_Message 300 -- 301 delay ImpDef.Long_Switch_To_New_Task; 302 303 Debit_Message.TC_Start; 304 305 while not Debit_Task'terminated loop 306 delay ImpDef.Long_Minimum_Task_Switch; 307 end loop; 308 309 Hold.Clear_DB_Overload; -- Allow completion 310 311 end; -- declare (encapsulation) 312 313 if TC_Error_01 then 314 Report.Failed ("Wait_for_CR_Underload executed out of sequence"); 315 end if; 316 if TC_Error_02 then 317 Report.Failed ("Credit: Entry executed before procedure"); 318 end if; 319 if TC_Error_03 then 320 Report.Failed ("Credit: Entry executed in parallel"); 321 end if; 322 if TC_Error_04 then 323 Report.Failed ("Wait_for_DB_Underload executed out of sequence"); 324 end if; 325 if TC_Error_05 then 326 Report.Failed ("Debit: Entry executed before procedure"); 327 end if; 328 if TC_Error_06 then 329 Report.Failed ("Debit: Entry executed in parallel"); 330 end if; 331 332 Report.Result; 333 334end C951002; 335