1-- C910001.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 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. 31-- 32-- TEST DESCRIPTION: 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 39-- same array. 40-- 41-- 42-- CHANGE HISTORY: 43-- 06 Dec 94 SAIC ACVC 2.0 44-- 45--! 46 47with Report; 48 49procedure C910001 is 50 51 52 type App_Priority is range 1..10; 53 Default_Priority : App_Priority := 5; 54 55 type Message_ID is range 1..10_000; 56 57 type TC_Number_of_Messages is range 1..5; 58 59 type TC_rec is record 60 TC_ID : Message_ID; 61 A_Priority : App_Priority; 62 TC_Checked : Boolean; 63 end record; 64 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 := 67 ( ( 10, 6, false ), 68 ( 20, 2, false ), 69 ( 30, 9, false ), 70 ( 40, 1, false ), 71 ( 50, Default_Priority, false ) ); 72 73begin -- C910001 74 75 Report.Test ("C910001", "Check that tasks may have discriminants"); 76 77 78 declare -- encapsulate the test 79 80 type Transaction_Record is 81 record 82 ID : Message_ID; 83 Account_Number : integer := 0; 84 Stock_Number : integer := 0; 85 Quantity : integer := 0; 86 Return_Value : integer := 0; 87 end record; 88 -- 89 type acc_Transaction_Record is access Transaction_Record; 90 91 92 task type Message_Task 93 (In_Message : acc_Transaction_Record := null; 94 In_Priority : App_Priority := Default_Priority) is 95 entry Start; 96 end Message_Task; 97 type acc_Message_Task is access Message_Task; 98 -- 99 -- 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; 104 begin 105 accept Start; 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 111 -- 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"); 118 end if; 119 if TC_Table (TC_Number_of_Messages'Last).TC_Checked then 120 Report.Failed ("Duplicate Default messages"); 121 else 122 -- Mark that default has been seen 123 TC_Table (TC_Number_of_Messages'Last).TC_Checked := True; 124 end if; 125 TC_Match_Found := true; 126 else 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 132 -- Already checked 133 Report.Failed ("Duplicate Data"); 134 else 135 TC_Table(i).TC_checked := true; 136 end if; 137 TC_Match_Found := true; 138 if TC_Table(i).A_Priority /= This_Priority then 139 Report.Failed ("ID/Priority mismatch"); 140 end if; 141 exit; 142 end if; 143 end loop; 144 end if; 145 146 if not TC_Match_Found then 147 Report.Failed ("No ID match in table"); 148 end if; 149 150 -- Allow the task to terminate 151 152 end Message_Task; 153 154 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. 165 -- 166 task Driver_Task; 167 -- 168 task body Driver_Task is 169 begin 170 171 -- Create all but one of the required tasks 172 -- 173 for i in 1..TC_Number_of_Messages'Last - 1 loop 174 declare 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 ); 182 183 begin 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; 187 188 -- Ensure the task does not start executing till the 189 -- transaction record is properly constructed 190 Next_Message_Task.Start; 191 192 end; -- declare 193 end loop; 194 195 -- For this subtest create one task with the default discriminants 196 -- 197 declare 198 199 -- Create the task 200 Next_Message_Task : acc_Message_Task := new Message_Task; 201 202 begin 203 204 Next_Message_Task.Start; 205 206 end; -- declare 207 208 209 end Driver_Task; 210 211 begin 212 null; 213 end; -- encapsulation 214 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 218 Report.Failed 219 ("Task" & integer'image(integer (i) ) & " did not verify"); 220 end if; 221 end loop; 222 Report.Result; 223 224end C910001; 225