3 -- Grant of Unlimited Rights
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
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.
27 -- Check that tasks may have discriminants. Specifically, check where
28 -- the subtype of the discriminant is a discrete subtype and where it is
29 -- an access subtype. Check the case where the default values of the
30 -- discriminants are used.
33 -- A task is defined with two discriminants, one a discrete subtype and
34 -- another that is an access subtype. Tasks are created with various
35 -- values for discriminants and code within the task checks that these
36 -- are passed in correctly. One instance of a default is used. The
37 -- values passed to the task as the discriminants are taken from an
38 -- array of test data and the values received are checked against the
43 -- 06 Dec 94 SAIC ACVC 2.0
52 type App_Priority
is range 1..10;
53 Default_Priority
: App_Priority
:= 5;
55 type Message_ID
is range 1..10_000
;
57 type TC_Number_of_Messages
is range 1..5;
61 A_Priority
: App_Priority
;
65 -- This table is used to create the messages and to check them
66 TC_table
: array (1..TC_Number_of_Messages
'Last) of TC_Rec
:=
71 ( 50, Default_Priority
, false ) );
75 Report
.Test
("C910001", "Check that tasks may have discriminants");
78 declare -- encapsulate the test
80 type Transaction_Record
is
83 Account_Number
: integer := 0;
84 Stock_Number
: integer := 0;
85 Quantity
: integer := 0;
86 Return_Value
: integer := 0;
89 type acc_Transaction_Record
is access Transaction_Record
;
92 task type Message_Task
93 (In_Message
: acc_Transaction_Record
:= null;
94 In_Priority
: App_Priority
:= Default_Priority
) is
97 type acc_Message_Task
is access Message_Task
;
100 task body Message_Task
is
101 This_Message
: acc_Transaction_Record
:= In_Message
;
102 This_Priority
: App_Priority
:= In_Priority
;
103 TC_Match_Found
: Boolean := false;
106 -- In the example envisioned this task would then queue itself
107 -- upon some Distributor task which would send it off (requeue) to
108 -- the message processing tasks according to the priority of the
109 -- message and the current load on the system. For the test we
110 -- just verify the data passed in as discriminants and exit the task
112 -- Check for the special case of default discriminants
113 if This_Message
= null then
114 -- The default In_Message has been passed, check that the
115 -- default priority was also passed
116 if This_Priority
/= Default_Priority
then
117 Report
.Failed
("Incorrect Default Priority");
119 if TC_Table
(TC_Number_of_Messages
'Last).TC_Checked
then
120 Report
.Failed
("Duplicate Default messages");
122 -- Mark that default has been seen
123 TC_Table
(TC_Number_of_Messages
'Last).TC_Checked
:= True;
125 TC_Match_Found
:= true;
127 -- Check the data against the table
128 for i
in TC_Number_of_Messages
loop
129 if TC_Table
(i
).TC_ID
= This_Message
.ID
then
130 -- this is the right slot in the table
131 if TC_Table
(i
).TC_checked
then
133 Report
.Failed
("Duplicate Data");
135 TC_Table
(i
).TC_checked
:= true;
137 TC_Match_Found
:= true;
138 if TC_Table
(i
).A_Priority
/= This_Priority
then
139 Report
.Failed
("ID/Priority mismatch");
146 if not TC_Match_Found
then
147 Report
.Failed
("No ID match in table");
150 -- Allow the task to terminate
155 -- The Line Driver task accepts data from an external source and
156 -- builds them into a transaction record. It then generates a
157 -- message task. This message "contains" the record and is given
158 -- a priority according to the contents of the message. The priority
159 -- and transaction records are passed to the task as discriminants.
160 -- In this test we use a dummy record. Only the ID is of interest
161 -- so we pick that and the required priority from an array of
162 -- test data. We artificially limit the endless driver-loop to
163 -- the number of messages required for the test and add a special
164 -- case to check the defaults.
168 task body Driver_Task
is
171 -- Create all but one of the required tasks
173 for i
in 1..TC_Number_of_Messages
'Last - 1 loop
175 -- Create a record for the next message
176 Next_Transaction
: acc_Transaction_Record
:=
177 new Transaction_Record
;
178 -- Create a task for the next message
179 Next_Message_Task
: acc_Message_Task
:=
180 new Message_Task
( Next_Transaction
,
181 TC_Table
(i
).A_Priority
);
184 -- Artificially plug the ID with the next from the table
185 -- In reality the whole record would be built here
186 Next_Transaction
.ID
:= TC_Table
(i
).TC_ID
;
188 -- Ensure the task does not start executing till the
189 -- transaction record is properly constructed
190 Next_Message_Task
.Start
;
195 -- For this subtest create one task with the default discriminants
200 Next_Message_Task
: acc_Message_Task
:= new Message_Task
;
204 Next_Message_Task
.Start
;
213 end; -- encapsulation
215 -- Now verify that all the tasks executed and checked in
216 for i
in TC_Number_of_Messages
loop
217 if not TC_Table
(i
).TC_Checked
then
219 ("Task" & integer'image(integer (i
) ) & " did not verify");