1-- C940001.A 2-- 3-- 4-- Grant of Unlimited Rights 5-- 6-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 7-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 8-- unlimited rights in the software and documentation contained herein. 9-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 10-- this public release, the Government intends to confer upon all 11-- recipients unlimited rights equal to those held by the Government. 12-- These rights include rights to use, duplicate, release or disclose the 13-- released technical data and computer software in whole or in part, in 14-- any manner and for any purpose whatsoever, and to have or permit others 15-- to do so. 16-- 17-- DISCLAIMER 18-- 19-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 20-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 21-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 22-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 23-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 24-- PARTICULAR PURPOSE OF SAID MATERIAL. 25--* 26-- 27-- OBJECTIVE: 28-- Check that a protected object provides coordinated access to 29-- shared data. Check that it can be used to sequence a number of tasks. 30-- Use the protected object to control a single token for which three 31-- tasks compete. Check that only one task is running at a time and that 32-- all tasks get a chance to run sometime. 33-- 34-- TEST DESCRIPTION: 35-- Declare a protected type with two entries. A task may call the Take 36-- entry to get a token which allows it to continue processing. If it 37-- has the token, it may call the Give entry to return it. The tasks 38-- implement a discipline whereby only the task with the token may be 39-- active. The test does not require any specific order for the tasks 40-- to run. 41-- 42-- 43-- CHANGE HISTORY: 44-- 06 Dec 94 SAIC ACVC 2.0 45-- 07 Jul 96 SAIC Fixed spelling nits. 46-- 47--! 48 49package C940001_0 is 50 51 type Token_Type is private; 52 True_Token : constant Token_Type; -- Create a deferred constant in order 53 -- to provide a component init for the 54 -- protected object 55 56 protected type Token_Mgr_Prot_Unit is 57 entry Take (T : out Token_Type); 58 entry Give (T : in out Token_Type); 59 private 60 Token : Token_Type := True_Token; 61 end Token_Mgr_Prot_Unit; 62 63 function Init_Token return Token_Type; -- call to initialize an 64 -- object of Token_Type 65 function Token_Value (T : Token_Type) return Boolean; 66 -- call to inspect the value of an 67 -- object of Token_Type 68private 69 type Token_Type is new boolean; 70 True_Token : constant Token_Type := true; 71end C940001_0; 72 73--=================================================================-- 74 75package body C940001_0 is 76 protected body Token_Mgr_Prot_Unit is 77 entry Take (T : out Token_Type) when Token = true is 78 begin -- Calling task will Take the token, so 79 T := Token; -- check first that token_mgr owns the 80 Token := false; -- token to give, then give it to caller 81 end Take; 82 83 entry Give (T : in out Token_Type) when Token = false is 84 begin -- Calling task will Give the token back, 85 if T = true then -- so first check that token_mgr does not 86 Token := T; -- own the token, then check that the task has 87 T := false; -- the token to give, then take it from the 88 end if; -- task 89 -- if caller does not own the token, then 90 end Give; -- it falls out of the entry body with no 91 end Token_Mgr_Prot_Unit; -- action 92 93 function Init_Token return Token_Type is 94 begin 95 return false; 96 end Init_Token; 97 98 function Token_Value (T : Token_Type) return Boolean is 99 begin 100 return Boolean (T); 101 end Token_Value; 102 103end C940001_0; 104 105--===============================================================-- 106 107with Report; 108with ImpDef; 109with C940001_0; 110 111procedure C940001 is 112 113 type TC_Int_Type is range 0..2; 114 -- range is very narrow so that erroneous execution may 115 -- raise Constraint_Error 116 117 type TC_Artifact_Type is record 118 TC_Int : TC_Int_Type := 1; 119 Number_of_Accesses : integer := 0; 120 end record; 121 122 TC_Artifact : TC_Artifact_Type; 123 124 Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit; 125 126 procedure Bump (Item : in out TC_Int_Type) is 127 begin 128 Item := Item + 1; 129 exception 130 when Constraint_Error => 131 Report.Failed ("Incremented without corresponding decrement"); 132 when others => 133 Report.Failed ("Bump raised Unexpected Exception"); 134 end Bump; 135 136 procedure Decrement (Item : in out TC_Int_Type) is 137 begin 138 Item := Item - 1; 139 exception 140 when Constraint_Error => 141 Report.Failed ("Decremented without corresponding increment"); 142 when others => 143 Report.Failed ("Decrement raised Unexpected Exception"); 144 end Decrement; 145 146 --==============-- 147 148 task type Network_Node_Type; 149 150 task body Network_Node_Type is 151 152 Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token; 153 154 begin 155 156 -- Ask for token - if request is not granted, task will be queued 157 Sequence_Mgr.Take (Slot_for_Token); 158 159 -- Task now has token and may perform its work 160 161 --==========================-- 162 -- in this case, the work is to ensure that the test results 163 -- are the expected ones! 164 --==========================-- 165 Bump (TC_Artifact.TC_Int); -- increment when request is granted 166 TC_Artifact.Number_Of_Accesses := 167 TC_Artifact.Number_Of_Accesses + 1; 168 if not C940001_0.Token_Value ( Slot_for_Token) then 169 Report.Failed ("Incorrect results from entry Take"); 170 end if; 171 172 -- give a chance for other tasks to (incorrectly) run 173 delay ImpDef.Minimum_Task_Switch; 174 175 Decrement (TC_Artifact.TC_Int); -- prepare to return token 176 177 -- Task has completed its work and will return token 178 179 Sequence_Mgr.Give (Slot_for_Token); -- return token to sequence manager 180 181 if c940001_0.Token_Value (Slot_for_Token) then 182 Report.Failed ("Incorrect results from entry Give"); 183 end if; 184 185 exception 186 when others => Report.Failed ("Unexpected exception raised in task"); 187 188 end Network_Node_Type; 189 190 --==============-- 191 192begin 193 194 Report.Test ("C940001", "Check that a protected object can control " & 195 "tasks by coordinating access to shared data"); 196 197 declare 198 Node_1, Node_2, Node_3 : Network_Node_Type; 199 -- declare three tasks which will compete for 200 -- a single token, managed by Sequence Manager 201 202 begin -- tasks start 203 null; 204 end; -- wait for all tasks to terminate before reporting result 205 206 if TC_Artifact.Number_of_Accesses /= 3 then 207 Report.Failed ("Not all tasks got through"); 208 end if; 209 210 Report.Result; 211 212end C940001; 213