1-- C954001.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 a requeue statement within an entry_body with parameters 28-- may requeue the entry call to a protected entry with a subtype- 29-- conformant parameter profile. Check that, if the call is queued on the 30-- new entry's queue, the original caller remains blocked after the 31-- requeue, but the entry_body containing the requeue is completed. 32-- 33-- TEST DESCRIPTION: 34-- Declare a protected object which simulates a disk device. Declare an 35-- entry that requeues the caller to a second entry if the disk head is 36-- not in the proper location, but first sets the second entry's barrier 37-- to false. Declare a procedure which sets the second entry's barrier 38-- to true. 39-- 40-- Declare a task which calls the first entry such that the requeue is 41-- called. This task should be queued on the second entry and remain 42-- blocked, and the first entry should be complete. Call the procedure 43-- which releases the second entry's queue. The second entry should 44-- complete, after which the task should complete. 45-- 46-- 47-- CHANGE HISTORY: 48-- 06 Dec 94 SAIC ACVC 2.0 49-- 50--! 51 52package C954001_0 is -- Disk management abstraction. 53 54 55 -- Simulate a read-only disk device with a head that may be moved to 56 -- different tracks. If a read request is issued for the current 57 -- track, the request can be satisfied immediately. Otherwise, the head 58 -- must be moved to the correct track, during which time the calling task 59 -- is blocked. When the head reaches the correct track, the disk generates 60 -- an interrupt, after which the request can be satisfied, and the 61 -- calling task can proceed. 62 63 Buffer_Size : constant := 100; 64 65 type Disk_Buffer is new String (1 .. Buffer_Size); 66 type Disk_Track is new Natural; 67 68 type Disk_Address is record 69 Track : Disk_Track; 70 -- Additional components. 71 end record; 72 73 Initial_Track : constant Disk_Track := 0; 74 New_Track : constant Disk_Track := 5; 75 76 --==============================================-- 77 78 protected Disk_Device is 79 80 entry Read (Where : Disk_Address; -- Read data from disk 81 Data : out Disk_Buffer); -- track. 82 83 procedure Disk_Interrupt; -- Handle interrupt 84 -- from disk. 85 86 function TC_Track return Disk_Track; -- Return current track. 87 88 function TC_Pending_Queued return Boolean; -- True when there is 89 -- an entry in queue 90 91 private 92 93 entry Pending_Read (Where : Disk_Address; -- Wait for head to 94 Data : out Disk_Buffer); -- move then read data. 95 96 Current_Track : Disk_Track := Initial_Track; -- Current disk track. 97 Operation_Pending : Boolean := False; -- Vis. entry barrier. 98 Disk_Interrupted : Boolean := False; -- Priv. entry barrier. 99 100 end Disk_Device; 101 102 103end C954001_0; 104 105 106 --==================================================================-- 107 108 109package body C954001_0 is -- Disk management abstraction. 110 111 112 protected body Disk_Device is 113 114 entry Read (Where : Disk_Address; Data : out Disk_Buffer) 115 when not Operation_Pending is 116 begin 117 if (Where.Track = Current_Track) then -- If the head is over the 118 -- Read data from disk... -- requested track, read 119 null; -- the data. 120 121 else -- Otherwise, defer read 122 Operation_Pending := True; -- while head is moved to 123 -- correct track (signaled 124 -- -- -- by a disk interrupt). 125 -- Requeue is tested here -- 126 -- -- 127 128 requeue Pending_Read; 129 130 end if; 131 end Read; 132 133 134 procedure Disk_Interrupt is -- Called when the disk 135 begin -- interrupts, indicating 136 Disk_Interrupted := True; -- that the head is over 137 end Disk_Interrupt; -- the correct track. 138 139 140 function TC_Track return Disk_Track is -- Artifice required for 141 begin -- testing purposes. 142 return (Current_Track); 143 end TC_Track; 144 145 146 entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer) 147 when Disk_Interrupted is 148 begin 149 Current_Track := Where.Track; -- Head is now over the 150 -- Read data from disk... -- correct track; read 151 Operation_Pending := False; -- the data. 152 Disk_Interrupted := False; 153 end Pending_Read; 154 155 function TC_Pending_Queued return Boolean is 156 begin 157 -- Return true when there is something on the Pending_Read queue 158 return (Pending_Read'Count /=0); 159 end TC_Pending_Queued; 160 161 end Disk_Device; 162 163 164end C954001_0; 165 166 167 --==================================================================-- 168 169 170with Report; 171with ImpDef; 172 173with C954001_0; -- Disk management abstraction. 174use C954001_0; 175 176procedure C954001 is 177 178 179 task type Read_Task is -- an unusual (but legal) declaration 180 end Read_Task; 181 -- 182 -- 183 task body Read_Task is 184 Location : constant Disk_Address := (Track => New_Track); 185 Data : Disk_Buffer := (others => ' '); 186 begin 187 Disk_Device.Read (Location, Data); -- Invoke requeue statement. 188 exception 189 when others => 190 Report.Failed ("Exception raised in task"); 191 end Read_Task; 192 193 --==============================================-- 194 195begin -- Main program. 196 197 Report.Test ("C954001", "Requeue from an entry within a P.O. " & 198 "to a private entry within the same P.O."); 199 200 201 declare 202 203 IO_Request : Read_Task; -- Request a read from other 204 -- than the current track. 205 -- IO_Request will be requeued 206 -- from Read to Pending_Read. 207 begin 208 209 -- To pass this test, the following must be true: 210 -- 211 -- (A) The Read entry call made by the task IO_Request must be 212 -- completed by the requeue. 213 -- (B) IO_Request must remain blocked following the requeue. 214 -- (C) IO_Request must be queued on the Pending_Read entry queue. 215 -- (D) IO_Request must continue execution after the Pending_Read 216 -- entry completes. 217 -- 218 -- First, verify (A): that the Read entry call is complete. 219 -- 220 -- Call a protected operation (Disk_Device.TC_Track). Since no two 221 -- protected actions may proceed concurrently unless both are protected 222 -- function calls, a call to a protected operation at this point can 223 -- proceed only if the Read entry call is already complete. 224 -- 225 -- Note that if Read is NOT complete, the test will likely hang here. 226 -- 227 -- Next, verify (B): that IO_Request remains blocked following the 228 -- requeue. Also verify that Pending_Read (the entry to which 229 -- IO_Request should have been queued) has not yet executed. 230 231 -- Wait until the task had made the call and the requeue has been 232 -- effected. 233 while not Disk_Device.TC_Pending_Queued loop 234 delay ImpDef.Minimum_Task_Switch; 235 end loop; 236 237 if Disk_Device.TC_Track /= Initial_Track then 238 Report.Failed ("Target entry of requeue executed prematurely"); 239 elsif IO_Request'Terminated then 240 Report.Failed ("Caller did not remain blocked after " & 241 "the requeue or was never requeued"); 242 else 243 244 -- Verify (C): that IO_Request is queued on the 245 -- Pending_Read entry queue. 246 -- 247 -- Set the barrier for Pending_Read to true. Check that the 248 -- current track is updated and that IO_Request terminates. 249 250 Disk_Device.Disk_Interrupt; -- Simulate a disk interrupt, 251 -- signaling that the head is 252 -- over the correct track. 253 254 -- The Pending_Read entry body will complete before the next 255 -- protected action is called (Disk_Device.TC_Track). 256 257 if Disk_Device.TC_Track /= New_Track then 258 Report.Failed ("Caller was not requeued on target entry"); 259 end if; 260 261 -- Finally, verify (D): that Read_Task continues after Pending_Read 262 -- completes. 263 -- 264 -- Note that the test will hang here if Read_Task does not continue 265 -- executing following the completion of the requeued entry call. 266 267 end if; 268 269 end; -- We will not exit the declare block until the task completes 270 271 Report.Result; 272 273end C954001; 274