c954001.a

来自「用于进行gcc测试」· A 代码 · 共 274 行

-- 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;