summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c954001.a
blob: 3112cce2b5cd6d915d11352e5d21848399b5bacd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
-- 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;