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
|
-- C95021A.ADA
-- 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.
--*
-- CHECK THAT CALLS TO AN ENTRY ARE PLACED IN A FIFO QUEUE.
-- JBG 2/22/84
-- DAS 10/8/90 ADDED PRAGMA PRIORITY TO ENSURE THAT THE FIFO
-- DISCIPLINE MUST BE FOLLOWED (OTHERWISE THE
-- IMPLEMENTATION MIGHT PROHIBIT QUEUES FROM
-- FORMING SO THAT E'COUNT IS ALWAYS ZERO FOR
-- AN ENTRY E).
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
-- THE TASK QUEUE IS THE TASK THAT CHECKS THE QUEUEING DISCIPLINE.
--
-- THIS TEST PLACES TWO CALLS ON AN ENTRY, WAITS UNTIL ONE OF THE CALLS
-- IS ACCEPTED, AND THEN PLACES A THIRD CALL ON THE ENTRY. THE TEST
-- CHECKS THAT THE SECOND CALL IS HANDLED BEFORE THE THIRD. (IT IS
-- NONDETERMINISTIC WHICH CALL WILL BE THE FIRST ONE ON THE QUEUE, SO
-- THIS MORE COMPLICATED APPROACH IS NECESSARY.)
--
-- THE TASK DISPATCH FIRES UP THE TWO TASKS THAT MAKE THE FIRST TWO
-- CALLS AND THEN WAITS UNTIL QUEUE SAYS IT IS READY FOR THE THIRD CALL.
--
-- THE TASK TYPE CALLERS IS USED TO CREATE TASKS THAT WILL CALL THE
-- ENTRY IN THE TASK QUEUE.
with Impdef;
WITH REPORT; USE REPORT;
WITH SYSTEM;
PROCEDURE C95021A IS
BEGIN
TEST ("C95021A", "CHECK THAT ENTRY CALLS ARE PUT IN FIFO QUEUES");
-- DO THIS TEST 3 TIMES TO ALLOW FOR RANDOM VARIATIONS IN TIMING.
FOR I IN 1..3 LOOP
COMMENT ("ITERATION" & INTEGER'IMAGE(I));
DECLARE
TASK TYPE CALLERS IS
ENTRY NAME (N : NATURAL);
END CALLERS;
TASK QUEUE IS
ENTRY GO;
ENTRY E1 (NAME : NATURAL);
END QUEUE;
TASK DISPATCH IS
ENTRY READY;
END DISPATCH;
TASK BODY CALLERS IS
MY_NAME : NATURAL;
BEGIN
-- GET NAME OF THIS TASK OBJECT
ACCEPT NAME (N : NATURAL) DO
MY_NAME := N;
END NAME;
-- PUT THIS TASK ON QUEUE FOR QUEUE.E1
QUEUE.E1 (MY_NAME);
END CALLERS;
TASK BODY DISPATCH IS
TYPE ACC_CALLERS IS ACCESS CALLERS;
OBJ : ACC_CALLERS;
BEGIN
-- FIRE UP TWO CALLERS FOR QUEUE.E1
OBJ := NEW CALLERS;
OBJ.NAME(1);
OBJ := NEW CALLERS;
OBJ.NAME(2);
-- ALLOW THESE CALLS TO BE PROCESSED (ONLY ONE WILL BE ACCEPTED).
QUEUE.GO;
-- WAIT TILL ONE CALL HAS BEEN PROCESSED.
ACCEPT READY; -- CALLED FROM QUEUE
-- FIRE UP THIRD CALLER
OBJ := NEW CALLERS;
OBJ.NAME(3);
END DISPATCH;
TASK BODY QUEUE IS
NEXT : NATURAL; -- NUMBER OF SECOND CALLER IN QUEUE.
BEGIN
-- WAIT UNTIL TWO TASKS CALLING E1 HAVE BEEN ACTIVATED.
ACCEPT GO;
-- WAIT FOR TWO CALLS TO BE AVAILABLE. THIS WAIT ASSUMES THAT THE
-- CALLER TASKS WILL PROCEED IF THIS TASK IS EXECUTING A DELAY
-- STATEMENT, ALTHOUGH THIS IS NOT STRICTLY REQUIRED BY THE STANDARD.
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
LOOP
EXIT WHEN E1'COUNT = 2;
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
END LOOP;
IF E1'COUNT /= 2 THEN
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
"MINUTE - 1");
END IF;
-- ASSUMING NO FAILURE, PROCESS ONE OF THE QUEUED CALLS.
ACCEPT E1 (NAME : NATURAL) DO
-- GET NAME OF NEXT CALLER
CASE NAME IS
WHEN 1 =>
NEXT := 2;
WHEN 2 =>
NEXT := 1;
WHEN OTHERS =>
FAILED ("UNEXPECTED ERROR");
END CASE;
END E1;
-- TELL DISPATCH TO FIRE UP NEXT CALLER (ONE IS STILL IN QUEUE).
DISPATCH.READY;
-- WAIT FOR CALL TO ARRIVE.
FOR I IN 1..6 -- WILL WAIT FOR ONE MINUTE
LOOP
EXIT WHEN E1'COUNT = 2;
DELAY 10.0 * Impdef.One_Second; -- WAIT FOR CALLS TO ARRIVE
END LOOP;
IF E1'COUNT /= 2 THEN
FAILED ("CALLER TASKS NOT QUEUED AFTER ONE " &
"MINUTE - 2");
END IF;
-- ASSUMING NO FAILURE, ACCEPT SECOND CALL AND CHECK THAT IT IS FROM THE
-- CORRECT TASK.
ACCEPT E1 (NAME : NATURAL) DO
IF NAME /= NEXT THEN
FAILED ("FIFO DISCIPLINE NOT OBEYED");
END IF;
END E1;
-- ACCEPT THE LAST CALLER
ACCEPT E1 (NAME : NATURAL);
END QUEUE;
BEGIN
NULL;
END; -- ALL TASKS NOW TERMINATED.
END LOOP;
RESULT;
END C95021A;
|
