1-- C95021A.ADA
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-- CHECK THAT CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
26
27-- JBG 2/22/84
28-- DAS 10/8/90  ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
29--              DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
30--              IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
31--              FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
32--              AN ENTRY E).
33-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
34
35-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
36--
37-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
38-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY.  THE TEST
39-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD.  (IT IS
40-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
41-- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
42--
43-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
44-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
45--
46-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
47-- ENTRY IN THE TASK QUEUE.
48
49with Impdef;
50WITH REPORT; USE REPORT;
51WITH SYSTEM;
52PROCEDURE C95021A IS
53BEGIN
54
55     TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
56
57-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
58     FOR I IN 1..3 LOOP
59          COMMENT ("ITERATION" & INTEGER'IMAGE(I));
60
61     DECLARE
62
63          TASK TYPE CALLERS IS
64               ENTRY NAME (N : NATURAL);
65          END CALLERS;
66
67          TASK QUEUE IS
68               ENTRY GO;
69               ENTRY E1 (NAME : NATURAL);
70          END QUEUE;
71
72          TASK DISPATCH IS
73               ENTRY READY;
74          END DISPATCH;
75
76          TASK BODY CALLERS IS
77               MY_NAME : NATURAL;
78          BEGIN
79
80-- GET NAME OF THIS TASK OBJECT
81               ACCEPT NAME (N : NATURAL) DO
82                    MY_NAME := N;
83               END NAME;
84
85-- PUT THIS TASK ON QUEUE FOR QUEUE.E1
86               QUEUE.E1 (MY_NAME);
87          END CALLERS;
88
89          TASK BODY DISPATCH IS
90               TYPE ACC_CALLERS IS ACCESS CALLERS;
91               OBJ : ACC_CALLERS;
92          BEGIN
93
94-- FIRE UP TWO CALLERS FOR QUEUE.E1
95               OBJ := NEW CALLERS;
96               OBJ.NAME(1);
97               OBJ := NEW CALLERS;
98               OBJ.NAME(2);
99
100-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
101               QUEUE.GO;
102
103-- WAIT TILL ONE CALL HAS BEEN PROCESSED.
104               ACCEPT READY;       -- CALLED FROM QUEUE
105
106-- FIRE UP THIRD CALLER
107               OBJ := NEW CALLERS;
108               OBJ.NAME(3);
109
110          END DISPATCH;
111
112          TASK BODY QUEUE IS
113               NEXT : NATURAL;     -- NUMBER OF SECOND CALLER IN QUEUE.
114          BEGIN
115
116-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
117               ACCEPT GO;
118
119-- WAIT FOR TWO CALLS TO BE AVAILABLE.  THIS WAIT ASSUMES THAT THE
120-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
121-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
122               FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
123               LOOP
124                    EXIT WHEN E1'COUNT = 2;
125                    DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
126               END LOOP;
127
128               IF E1'COUNT /= 2 THEN
129                    FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
130                            "MINUTE - 1");
131               END IF;
132
133-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
134               ACCEPT E1 (NAME : NATURAL) DO
135
136-- GET NAME OF NEXT CALLER
137                    CASE NAME IS
138                         WHEN 1 =>
139                              NEXT := 2;
140                         WHEN 2 =>
141                              NEXT := 1;
142                         WHEN OTHERS =>
143                              FAILED ("UNEXPECTED ERROR");
144                    END CASE;
145               END E1;
146
147-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
148               DISPATCH.READY;
149
150-- WAIT FOR CALL TO ARRIVE.
151               FOR I IN 1..6       -- WILL WAIT FOR ONE MINUTE
152               LOOP
153                    EXIT WHEN E1'COUNT = 2;
154                    DELAY 10.0 * Impdef.One_Second;    -- WAIT FOR CALLS TO ARRIVE
155               END LOOP;
156
157               IF E1'COUNT /= 2 THEN
158                    FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
159                            "MINUTE - 2");
160               END IF;
161
162-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
163-- CORRECT TASK.
164               ACCEPT E1 (NAME : NATURAL) DO
165                    IF NAME /= NEXT THEN
166                         FAILED ("FIFO DISCIPLINE NOT OBEYED");
167                    END IF;
168               END E1;
169
170-- ACCEPT THE LAST CALLER
171               ACCEPT E1 (NAME : NATURAL);
172
173          END QUEUE;
174
175     BEGIN
176          NULL;
177     END;           -- ALL TASKS NOW TERMINATED.
178     END LOOP;
179
180     RESULT;
181
182END C95021A;
183