1-- C34008A.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-- OBJECTIVE: 26-- CHECK THAT THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED 27-- (IMPLICITLY) FOR DERIVED TASK TYPES. 28 29-- HISTORY: 30-- JRK 08/27/87 CREATED ORIGINAL TEST. 31-- PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X. 32-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 33-- DTN 11/30/95 REMOVED ATTIBUTES OF NON-OBJECTS. 34 35WITH SYSTEM; USE SYSTEM; 36WITH REPORT; USE REPORT; 37 38PROCEDURE C34008A IS 39 40 PACKAGE PKG IS 41 42 TASK TYPE PARENT IS 43 ENTRY E (I : IN OUT INTEGER); 44 ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER); 45 ENTRY G; 46 ENTRY H (1 .. 3); 47 ENTRY R (I : OUT INTEGER); 48 ENTRY W (I : INTEGER); 49 END PARENT; 50 51 FUNCTION ID (X : PARENT) RETURN INTEGER; 52 53 END PKG; 54 55 USE PKG; 56 57 TYPE T IS NEW PARENT; 58 59 TASK TYPE AUX; 60 61 X : T; 62 W : PARENT; 63 B : BOOLEAN := FALSE; 64 I : INTEGER := 0; 65 J : INTEGER := 0; 66 A1, A2 : AUX; 67 68 PROCEDURE A (X : ADDRESS) IS 69 BEGIN 70 B := IDENT_BOOL (TRUE); 71 END A; 72 73 FUNCTION V RETURN T IS 74 BEGIN 75 RETURN X; 76 END V; 77 78 PACKAGE BODY PKG IS 79 80 TASK BODY PARENT IS 81 N : INTEGER := 1; 82 BEGIN 83 LOOP 84 SELECT 85 ACCEPT E (I : IN OUT INTEGER) DO 86 I := I + N; 87 END E; 88 OR 89 ACCEPT F (2) (I : INTEGER; J : OUT INTEGER) DO 90 J := I + N; 91 END F; 92 OR 93 ACCEPT G DO 94 WHILE H(2)'COUNT < 2 LOOP 95 DELAY 5.0; 96 END LOOP; 97 ACCEPT H (2) DO 98 IF E'COUNT /= 0 OR 99 F(1)'COUNT /= 0 OR 100 F(2)'COUNT /= 0 OR 101 F(3)'COUNT /= 0 OR 102 G'COUNT /= 0 OR 103 H(1)'COUNT /= 0 OR 104 H(2)'COUNT /= 1 OR 105 H(3)'COUNT /= 0 OR 106 R'COUNT /= 0 OR 107 W'COUNT /= 0 THEN 108 FAILED ("INCORRECT 'COUNT"); 109 END IF; 110 END H; 111 ACCEPT H (2); 112 END G; 113 OR 114 ACCEPT R (I : OUT INTEGER) DO 115 I := N; 116 END R; 117 OR 118 ACCEPT W (I : INTEGER) DO 119 N := I; 120 END W; 121 OR 122 TERMINATE; 123 END SELECT; 124 END LOOP; 125 END PARENT; 126 127 FUNCTION ID (X : PARENT) RETURN INTEGER IS 128 I : INTEGER; 129 BEGIN 130 X.R (I); 131 RETURN I; 132 END ID; 133 134 END PKG; 135 136 TASK BODY AUX IS 137 BEGIN 138 X.H (2); 139 END AUX; 140 141BEGIN 142 TEST ("C34008A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " & 143 "ARE DECLARED (IMPLICITLY) FOR DERIVED TASK " & 144 "TYPES"); 145 146 X.W (IDENT_INT (2)); 147 IF ID (X) /= 2 THEN 148 FAILED ("INCORRECT INITIALIZATION"); 149 END IF; 150 151 IF ID (T'(X)) /= 2 THEN 152 FAILED ("INCORRECT QUALIFICATION"); 153 END IF; 154 155 IF ID (T (X)) /= 2 THEN 156 FAILED ("INCORRECT SELF CONVERSION"); 157 END IF; 158 159 W.W (IDENT_INT (3)); 160 IF ID (T (W)) /= 3 THEN 161 FAILED ("INCORRECT CONVERSION FROM PARENT"); 162 END IF; 163 164 IF ID (PARENT (X)) /= 2 THEN 165 FAILED ("INCORRECT CONVERSION TO PARENT"); 166 END IF; 167 168 I := 5; 169 X.E (I); 170 IF I /= 7 THEN 171 FAILED ("INCORRECT SELECTION (ENTRY)"); 172 END IF; 173 174 I := 5; 175 X.F (IDENT_INT (2)) (I, J); 176 IF J /= 7 THEN 177 FAILED ("INCORRECT SELECTION (FAMILY)"); 178 END IF; 179 180 IF NOT (X IN T) THEN 181 FAILED ("INCORRECT ""IN"""); 182 END IF; 183 184 IF X NOT IN T THEN 185 FAILED ("INCORRECT ""NOT IN"""); 186 END IF; 187 188 189 B := FALSE; 190 A (X'ADDRESS); 191 IF NOT B THEN 192 FAILED ("INCORRECT OBJECT'ADDRESS"); 193 END IF; 194 195 IF NOT X'CALLABLE THEN 196 FAILED ("INCORRECT OBJECT'CALLABLE"); 197 END IF; 198 199 IF NOT V'CALLABLE THEN 200 FAILED ("INCORRECT VALUE'CALLABLE"); 201 END IF; 202 203 X.G; 204 205 IF X'SIZE < T'SIZE THEN 206 FAILED ("INCORRECT OBJECT'SIZE"); 207 END IF; 208 209 IF T'STORAGE_SIZE < 0 THEN 210 FAILED ("INCORRECT TYPE'STORAGE_SIZE"); 211 END IF; 212 213 IF X'STORAGE_SIZE < 0 THEN 214 FAILED ("INCORRECT OBJECT'STORAGE_SIZE"); 215 END IF; 216 217 IF X'TERMINATED THEN 218 FAILED ("INCORRECT OBJECT'TERMINATED"); 219 END IF; 220 221 IF V'TERMINATED THEN 222 FAILED ("INCORRECT VALUE'TERMINATED"); 223 END IF; 224 225 RESULT; 226END C34008A; 227