gcc/testsuite/ada/acats/tests/c9/c954001.a

   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
  52 package 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
 103 end C954001_0;
 104
 105
 106      --==================================================================--
 107
 108
 109 package 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
 164 end C954001_0;
 165
 166
 167      --==================================================================--
 168
 169
 170 with Report;
 171 with ImpDef;
 172
 173 with C954001_0;  -- Disk management abstraction.
 174 use  C954001_0;
 175
 176 procedure 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
 195 begin  -- 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
 273 end C954001;