1-- C34007J.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 ACCESS TYPES WHOSE DESIGNATED TYPE 28-- IS A TASK TYPE. 29 30-- HISTORY: 31-- JRK 09/26/86 CREATED ORIGINAL TEST. 32-- JLH 09/25/87 REFORMATTED HEADER. 33-- BCB 09/26/88 REMOVED COMPARISION INVOLVING OBJECT SIZE. 34-- BCB 03/07/90 PUT CHECK FOR 'STORAGE_SIZE IN EXCEPTION HANDLER. 35-- THS 09/18/90 REMOVED DECLARATION OF B, MADE THE BODY OF 36-- PROCEDURE A NULL, AND DELETED ALL REFERENCES TO B. 37-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 38 39WITH SYSTEM; USE SYSTEM; 40WITH REPORT; USE REPORT; 41 42PROCEDURE C34007J IS 43 44 TASK TYPE DESIGNATED IS 45 ENTRY E (I : IN OUT INTEGER); 46 ENTRY F (1 .. 3) (I : INTEGER; J : OUT INTEGER); 47 ENTRY R (I : OUT INTEGER); 48 ENTRY W (I : INTEGER); 49 END DESIGNATED; 50 51 TYPE PARENT IS ACCESS DESIGNATED; 52 53 TYPE T IS NEW PARENT; 54 55 X : T; 56 K : INTEGER := X'SIZE; 57 Y : T; 58 W : PARENT; 59 I : INTEGER := 0; 60 J : INTEGER := 0; 61 62 PROCEDURE A (X : ADDRESS) IS 63 BEGIN 64 NULL; 65 END A; 66 67 FUNCTION V RETURN T IS 68 BEGIN 69 RETURN NEW DESIGNATED; 70 END V; 71 72 FUNCTION IDENT (X : T) RETURN T IS 73 BEGIN 74 IF (X = NULL OR ELSE X'CALLABLE) OR IDENT_BOOL (TRUE) THEN 75 RETURN X; -- ALWAYS EXECUTED. 76 END IF; 77 RETURN NEW DESIGNATED; 78 END IDENT; 79 80 TASK BODY DESIGNATED 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 R (I : OUT INTEGER) DO 94 I := N; 95 END R; 96 OR 97 ACCEPT W (I : INTEGER) DO 98 N := I; 99 END W; 100 OR 101 TERMINATE; 102 END SELECT; 103 END LOOP; 104 END DESIGNATED; 105 106BEGIN 107 TEST ("C34007J", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " & 108 "ARE DECLARED (IMPLICITLY) FOR DERIVED " & 109 "ACCESS TYPES WHOSE DESIGNATED TYPE IS A " & 110 "TASK TYPE"); 111 112 X := NEW DESIGNATED; 113 Y := NEW DESIGNATED; 114 W := NEW DESIGNATED; 115 116 IF Y = NULL THEN 117 FAILED ("INCORRECT INITIALIZATION - 1"); 118 ELSE Y.W (2); 119 Y.R (I); 120 IF I /= 2 THEN 121 FAILED ("INCORRECT INITIALIZATION - 2"); 122 END IF; 123 END IF; 124 125 X := IDENT (Y); 126 IF X /= Y THEN 127 FAILED ("INCORRECT :="); 128 END IF; 129 130 IF T'(X) /= Y THEN 131 FAILED ("INCORRECT QUALIFICATION"); 132 END IF; 133 134 IF T (X) /= Y THEN 135 FAILED ("INCORRECT SELF CONVERSION"); 136 END IF; 137 138 IF EQUAL (3, 3) THEN 139 W := NEW DESIGNATED; 140 W.W (3); 141 END IF; 142 X := T (W); 143 IF X = NULL OR X = Y THEN 144 FAILED ("INCORRECT CONVERSION FROM PARENT - 1"); 145 ELSE I := 5; 146 X.E (I); 147 IF I /= 8 THEN 148 FAILED ("INCORRECT CONVERSION FROM PARENT - 2"); 149 END IF; 150 END IF; 151 152 X := IDENT (Y); 153 W := PARENT (X); 154 IF W = NULL OR T (W) /= Y THEN 155 FAILED ("INCORRECT CONVERSION TO PARENT - 1"); 156 ELSE I := 5; 157 W.E (I); 158 IF I /= 7 THEN 159 FAILED ("INCORRECT CONVERSION TO PARENT - 2"); 160 END IF; 161 END IF; 162 163 IF IDENT (NULL) /= NULL OR X = NULL THEN 164 FAILED ("INCORRECT NULL"); 165 END IF; 166 167 X := IDENT (NEW DESIGNATED); 168 IF X = NULL OR X = Y THEN 169 FAILED ("INCORRECT ALLOCATOR - 1"); 170 ELSE I := 5; 171 X.E (I); 172 IF I /= 6 THEN 173 FAILED ("INCORRECT ALLOCATOR - 2"); 174 END IF; 175 END IF; 176 177 X := IDENT (Y); 178 I := 5; 179 X.E (I); 180 IF I /= 7 THEN 181 FAILED ("INCORRECT SELECTION (ENTRY)"); 182 END IF; 183 184 I := 5; 185 X.F (IDENT_INT (2)) (I, J); 186 IF J /= 7 THEN 187 FAILED ("INCORRECT SELECTION (FAMILY)"); 188 END IF; 189 190 I := 5; 191 X.ALL.E (I); 192 IF I /= 7 THEN 193 FAILED ("INCORRECT .ALL"); 194 END IF; 195 196 X := IDENT (NULL); 197 BEGIN 198 IF X.ALL'CALLABLE THEN 199 FAILED ("NO EXCEPTION FOR NULL.ALL - 1"); 200 ELSE FAILED ("NO EXCEPTION FOR NULL.ALL - 2"); 201 END IF; 202 EXCEPTION 203 WHEN CONSTRAINT_ERROR => 204 NULL; 205 WHEN OTHERS => 206 FAILED ("WRONG EXCEPTION FOR NULL.ALL"); 207 END; 208 209 X := IDENT (Y); 210 IF X = NULL OR X = NEW DESIGNATED OR NOT (X = Y) THEN 211 FAILED ("INCORRECT ="); 212 END IF; 213 214 IF X /= Y OR NOT (X /= NULL) THEN 215 FAILED ("INCORRECT /="); 216 END IF; 217 218 IF NOT (X IN T) THEN 219 FAILED ("INCORRECT ""IN"""); 220 END IF; 221 222 IF X NOT IN T THEN 223 FAILED ("INCORRECT ""NOT IN"""); 224 END IF; 225 226 A (X'ADDRESS); 227 228 IF NOT X'CALLABLE THEN 229 FAILED ("INCORRECT OBJECT'CALLABLE"); 230 END IF; 231 232 IF NOT V'CALLABLE THEN 233 FAILED ("INCORRECT VALUE'CALLABLE"); 234 END IF; 235 236 BEGIN 237 IF T'STORAGE_SIZE /= PARENT'STORAGE_SIZE THEN 238 FAILED ("COLLECTION SIZE OF DERIVED TYPE IS NOT " & 239 "EQUAL TO COLLECTION SIZE OF PARENT TYPE"); 240 END IF; 241 EXCEPTION 242 WHEN PROGRAM_ERROR => 243 COMMENT ("PROGRAM_ERROR RAISED FOR " & 244 "UNDEFINED STORAGE_SIZE (AI-00608)"); 245 WHEN OTHERS => 246 FAILED ("UNEXPECTED EXCEPTION RAISED"); 247 END; 248 249 IF X'TERMINATED THEN 250 FAILED ("INCORRECT OBJECT'TERMINATED"); 251 END IF; 252 253 IF V'TERMINATED THEN 254 FAILED ("INCORRECT VALUE'TERMINATED"); 255 END IF; 256 257 RESULT; 258END C34007J; 259