diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c954001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c954001.a | 273 |
1 files changed, 0 insertions, 273 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c954001.a b/gcc/testsuite/ada/acats/tests/c9/c954001.a deleted file mode 100644 index 3112cce2b5c..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c954001.a +++ /dev/null @@ -1,273 +0,0 @@ --- C954001.A --- --- Grant of Unlimited Rights --- --- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, --- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained --- unlimited rights in the software and documentation contained herein. --- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making --- this public release, the Government intends to confer upon all --- recipients unlimited rights equal to those held by the Government. --- These rights include rights to use, duplicate, release or disclose the --- released technical data and computer software in whole or in part, in --- any manner and for any purpose whatsoever, and to have or permit others --- to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- OBJECTIVE: --- Check that a requeue statement within an entry_body with parameters --- may requeue the entry call to a protected entry with a subtype- --- conformant parameter profile. Check that, if the call is queued on the --- new entry's queue, the original caller remains blocked after the --- requeue, but the entry_body containing the requeue is completed. --- --- TEST DESCRIPTION: --- Declare a protected object which simulates a disk device. Declare an --- entry that requeues the caller to a second entry if the disk head is --- not in the proper location, but first sets the second entry's barrier --- to false. Declare a procedure which sets the second entry's barrier --- to true. --- --- Declare a task which calls the first entry such that the requeue is --- called. This task should be queued on the second entry and remain --- blocked, and the first entry should be complete. Call the procedure --- which releases the second entry's queue. The second entry should --- complete, after which the task should complete. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package C954001_0 is -- Disk management abstraction. - - - -- Simulate a read-only disk device with a head that may be moved to - -- different tracks. If a read request is issued for the current - -- track, the request can be satisfied immediately. Otherwise, the head - -- must be moved to the correct track, during which time the calling task - -- is blocked. When the head reaches the correct track, the disk generates - -- an interrupt, after which the request can be satisfied, and the - -- calling task can proceed. - - Buffer_Size : constant := 100; - - type Disk_Buffer is new String (1 .. Buffer_Size); - type Disk_Track is new Natural; - - type Disk_Address is record - Track : Disk_Track; - -- Additional components. - end record; - - Initial_Track : constant Disk_Track := 0; - New_Track : constant Disk_Track := 5; - - --==============================================-- - - protected Disk_Device is - - entry Read (Where : Disk_Address; -- Read data from disk - Data : out Disk_Buffer); -- track. - - procedure Disk_Interrupt; -- Handle interrupt - -- from disk. - - function TC_Track return Disk_Track; -- Return current track. - - function TC_Pending_Queued return Boolean; -- True when there is - -- an entry in queue - - private - - entry Pending_Read (Where : Disk_Address; -- Wait for head to - Data : out Disk_Buffer); -- move then read data. - - Current_Track : Disk_Track := Initial_Track; -- Current disk track. - Operation_Pending : Boolean := False; -- Vis. entry barrier. - Disk_Interrupted : Boolean := False; -- Priv. entry barrier. - - end Disk_Device; - - -end C954001_0; - - - --==================================================================-- - - -package body C954001_0 is -- Disk management abstraction. - - - protected body Disk_Device is - - entry Read (Where : Disk_Address; Data : out Disk_Buffer) - when not Operation_Pending is - begin - if (Where.Track = Current_Track) then -- If the head is over the - -- Read data from disk... -- requested track, read - null; -- the data. - - else -- Otherwise, defer read - Operation_Pending := True; -- while head is moved to - -- correct track (signaled - -- -- -- by a disk interrupt). - -- Requeue is tested here -- - -- -- - - requeue Pending_Read; - - end if; - end Read; - - - procedure Disk_Interrupt is -- Called when the disk - begin -- interrupts, indicating - Disk_Interrupted := True; -- that the head is over - end Disk_Interrupt; -- the correct track. - - - function TC_Track return Disk_Track is -- Artifice required for - begin -- testing purposes. - return (Current_Track); - end TC_Track; - - - entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer) - when Disk_Interrupted is - begin - Current_Track := Where.Track; -- Head is now over the - -- Read data from disk... -- correct track; read - Operation_Pending := False; -- the data. - Disk_Interrupted := False; - end Pending_Read; - - function TC_Pending_Queued return Boolean is - begin - -- Return true when there is something on the Pending_Read queue - return (Pending_Read'Count /=0); - end TC_Pending_Queued; - - end Disk_Device; - - -end C954001_0; - - - --==================================================================-- - - -with Report; -with ImpDef; - -with C954001_0; -- Disk management abstraction. -use C954001_0; - -procedure C954001 is - - - task type Read_Task is -- an unusual (but legal) declaration - end Read_Task; - -- - -- - task body Read_Task is - Location : constant Disk_Address := (Track => New_Track); - Data : Disk_Buffer := (others => ' '); - begin - Disk_Device.Read (Location, Data); -- Invoke requeue statement. - exception - when others => - Report.Failed ("Exception raised in task"); - end Read_Task; - - --==============================================-- - -begin -- Main program. - - Report.Test ("C954001", "Requeue from an entry within a P.O. " & - "to a private entry within the same P.O."); - - - declare - - IO_Request : Read_Task; -- Request a read from other - -- than the current track. - -- IO_Request will be requeued - -- from Read to Pending_Read. - begin - - -- To pass this test, the following must be true: - -- - -- (A) The Read entry call made by the task IO_Request must be - -- completed by the requeue. - -- (B) IO_Request must remain blocked following the requeue. - -- (C) IO_Request must be queued on the Pending_Read entry queue. - -- (D) IO_Request must continue execution after the Pending_Read - -- entry completes. - -- - -- First, verify (A): that the Read entry call is complete. - -- - -- Call a protected operation (Disk_Device.TC_Track). Since no two - -- protected actions may proceed concurrently unless both are protected - -- function calls, a call to a protected operation at this point can - -- proceed only if the Read entry call is already complete. - -- - -- Note that if Read is NOT complete, the test will likely hang here. - -- - -- Next, verify (B): that IO_Request remains blocked following the - -- requeue. Also verify that Pending_Read (the entry to which - -- IO_Request should have been queued) has not yet executed. - - -- Wait until the task had made the call and the requeue has been - -- effected. - while not Disk_Device.TC_Pending_Queued loop - delay ImpDef.Minimum_Task_Switch; - end loop; - - if Disk_Device.TC_Track /= Initial_Track then - Report.Failed ("Target entry of requeue executed prematurely"); - elsif IO_Request'Terminated then - Report.Failed ("Caller did not remain blocked after " & - "the requeue or was never requeued"); - else - - -- Verify (C): that IO_Request is queued on the - -- Pending_Read entry queue. - -- - -- Set the barrier for Pending_Read to true. Check that the - -- current track is updated and that IO_Request terminates. - - Disk_Device.Disk_Interrupt; -- Simulate a disk interrupt, - -- signaling that the head is - -- over the correct track. - - -- The Pending_Read entry body will complete before the next - -- protected action is called (Disk_Device.TC_Track). - - if Disk_Device.TC_Track /= New_Track then - Report.Failed ("Caller was not requeued on target entry"); - end if; - - -- Finally, verify (D): that Read_Task continues after Pending_Read - -- completes. - -- - -- Note that the test will hang here if Read_Task does not continue - -- executing following the completion of the requeued entry call. - - end if; - - end; -- We will not exit the declare block until the task completes - - Report.Result; - -end C954001; |