1-- CC1225A.TST 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, FOR A FORMAL ACCESS TYPE, THAT ALL ALLOWABLE OPERATIONS 27-- ARE IMPLICITLY DECLARED. 28 29-- MACRO SUBSTITUTION: 30-- $TASK_STORAGE_SIZE IS THE NUMBER OF STORAGE_UNITS REQUIRED FOR 31-- THE ACTIVATION OF A TASK. 32 33-- HISTORY: 34-- BCB 03/29/88 CREATED ORIGINAL TEST. 35-- RDH 04/09/90 ADDED 'STORAGE_SIZE CLAUSES. CHANGED EXTENSION TO 36-- 'TST'. 37-- LDC 09/26/90 REMOVED 'USE PACK' AFTER THE WITH SINCE IT ISN'T 38-- NEEDED, ADDED CHECK FOR NULL AFTER ASSIGMENT TO 39-- NULL, ADDED CHECKS FOR OTHER RELATION OPERATORS, 40-- CHANGED CHECK FOR 'ADDRESS TO A PROCEDURE CALL. 41-- LDC 10/13/90 CHANGED CHECK FOR 'SIZE TO ONLY CHECK FOR 42-- AVAILABILITY. CHANGED CHECK FOR 'ADDRESS TO A 43-- MEMBERSHIP TEST. 44-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 45 46WITH REPORT; USE REPORT; 47WITH SYSTEM; USE SYSTEM; 48 49PROCEDURE CC1225A IS 50 51 TASK_STORAGE_SIZE : CONSTANT := $TASK_STORAGE_SIZE; 52 53 TYPE AI IS ACCESS INTEGER; 54 55 TYPE ACCINTEGER IS ACCESS INTEGER; 56 57 TYPE REC IS RECORD 58 COMP : INTEGER; 59 END RECORD; 60 61 TYPE DISCREC (DISC : INTEGER := 1) IS RECORD 62 COMPD : INTEGER; 63 END RECORD; 64 65 TYPE AREC IS ACCESS REC; 66 67 TYPE ADISCREC IS ACCESS DISCREC; 68 69 TYPE ARR IS ARRAY(1..2,1..2) OF INTEGER; 70 71 TYPE ONEDIM IS ARRAY(1..10) OF INTEGER; 72 73 TYPE AA IS ACCESS ARR; 74 75 TYPE AONEDIM IS ACCESS ONEDIM; 76 77 TYPE ENUM IS (ONE, TWO, THREE); 78 79 TASK TYPE T IS 80 ENTRY HERE(VAL : IN OUT INTEGER); 81 END T; 82 83 TYPE ATASK IS ACCESS T; 84 85 TYPE ANOTHERTASK IS ACCESS T; 86 FOR ANOTHERTASK'STORAGE_SIZE USE 2 * TASK_STORAGE_SIZE; 87 88 TASK TYPE T1 IS 89 ENTRY HERE1(ENUM)(VAL1 : IN OUT INTEGER); 90 END T1; 91 92 TYPE ATASK1 IS ACCESS T1; 93 94 TASK BODY T IS 95 BEGIN 96 ACCEPT HERE(VAL : IN OUT INTEGER) DO 97 VAL := VAL * 2; 98 END HERE; 99 END T; 100 101 TASK BODY T1 IS 102 BEGIN 103 SELECT 104 ACCEPT HERE1(ONE)(VAL1 : IN OUT INTEGER) DO 105 VAL1 := VAL1 * 1; 106 END HERE1; 107 OR 108 ACCEPT HERE1(TWO)(VAL1 : IN OUT INTEGER) DO 109 VAL1 := VAL1 * 2; 110 END HERE1; 111 OR 112 ACCEPT HERE1(THREE)(VAL1 : IN OUT INTEGER) DO 113 VAL1 := VAL1 * 3; 114 END HERE1; 115 END SELECT; 116 END T1; 117 118 GENERIC 119 TYPE FORM IS (<>); 120 TYPE ACCFORM IS ACCESS FORM; 121 TYPE ACC IS ACCESS INTEGER; 122 TYPE ACCREC IS ACCESS REC; 123 TYPE ACCDISCREC IS ACCESS DISCREC; 124 TYPE ACCARR IS ACCESS ARR; 125 TYPE ACCONE IS ACCESS ONEDIM; 126 TYPE ACCTASK IS ACCESS T; 127 TYPE ACCTASK1 IS ACCESS T1; 128 TYPE ANOTHERTASK1 IS ACCESS T; 129 PACKAGE P IS 130 END P; 131 132 PACKAGE BODY P IS 133 AF : ACCFORM; 134 TYPE DER_ACC IS NEW ACC; 135 A, B : ACC; 136 DERA : DER_ACC; 137 R : ACCREC; 138 DR : ACCDISCREC; 139 C : ACCARR; 140 D, E : ACCONE; 141 F : ACCTASK; 142 G : ACCTASK1; 143 INT : INTEGER := 5; 144 145 BEGIN 146 TEST ("CC1225A", "CHECK, FOR A FORMAL ACCESS TYPE, THAT " & 147 "ALL ALLOWABLE OPERATIONS ARE IMPLICITLY " & 148 "DECLARED"); 149 150 IF AF'ADDRESS NOT IN ADDRESS THEN 151 FAILED ("IMPROPER RESULT FROM AF'ADDRESS TEST"); 152 END IF; 153 154 DECLARE 155 AF_SIZE : INTEGER := ACCFORM'SIZE; 156 BEGIN 157 IF AF_SIZE NOT IN INTEGER THEN 158 FAILED ("IMPROPER RESULT FROM AF'SIZE"); 159 END IF; 160 END; 161 162 IF ANOTHERTASK1'STORAGE_SIZE < TASK_STORAGE_SIZE THEN 163 FAILED ("IMPROPER VALUE FOR ANOTHERTASK1'STORAGE_SIZE"); 164 END IF; 165 166 B := NEW INTEGER'(25); 167 168 A := B; 169 170 IF A.ALL /= 25 THEN 171 FAILED ("IMPROPER VALUE FOR ASSIGNMENT OF VARIABLE " & 172 "OF A FORMAL ACCESS TYPE FROM ANOTHER " & 173 "VARIABLE OF A FORMAL ACCESS TYPE"); 174 END IF; 175 176 A := NEW INTEGER'(10); 177 178 IF A.ALL /= 10 THEN 179 FAILED ("IMPROPER VALUE FOR VARIABLE OF FORMAL ACCESS " & 180 "TYPE"); 181 END IF; 182 183 IF A NOT IN ACC THEN 184 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST"); 185 END IF; 186 187 B := ACC'(A); 188 189 IF B.ALL /= 10 THEN 190 FAILED ("IMPROPER VALUE FROM QUALIFICATION"); 191 END IF; 192 193 DERA := NEW INTEGER'(10); 194 A := ACC(DERA); 195 196 IF A.ALL /= IDENT_INT(10) THEN 197 FAILED ("IMPROPER VALUE FROM EXPLICIT CONVERSION"); 198 END IF; 199 200 IF A.ALL > IDENT_INT(10) THEN 201 FAILED ("IMPROPER VALUE USED IN LESS THAN"); 202 END IF; 203 204 IF A.ALL < IDENT_INT(10) THEN 205 FAILED ("IMPROPER VALUE USED IN GREATER THAN"); 206 END IF; 207 208 IF A.ALL >= IDENT_INT(11) THEN 209 FAILED ("IMPROPER VALUE USED IN LESS THAN OR EQUAL"); 210 END IF; 211 212 IF A.ALL <= IDENT_INT(9) THEN 213 FAILED ("IMPROPER VALUE USED IN GREATER THAN OR EQUAL"); 214 END IF; 215 216 IF NOT (A.ALL + A.ALL = IDENT_INT(20)) THEN 217 FAILED ("IMPROPER VALUE FROM ADDITION"); 218 END IF; 219 220 IF NOT (A.ALL - IDENT_INT(2) = IDENT_INT(8)) THEN 221 FAILED ("IMPROPER VALUE FROM SUBTRACTION"); 222 END IF; 223 224 IF NOT (A.ALL * IDENT_INT(3) = IDENT_INT(30)) THEN 225 FAILED ("IMPROPER VALUE FROM MULTIPLICATION"); 226 END IF; 227 228 IF NOT (A.ALL / IDENT_INT(3) = IDENT_INT(3)) THEN 229 FAILED ("IMPROPER VALUE FROM DIVISION"); 230 END IF; 231 232 IF NOT (A.ALL MOD IDENT_INT(3) = IDENT_INT(1)) THEN 233 FAILED ("IMPROPER VALUE FROM MODULO"); 234 END IF; 235 236 IF NOT (A.ALL REM IDENT_INT(7) = IDENT_INT(3)) THEN 237 FAILED ("IMPROPER VALUE FROM REMAINDER"); 238 END IF; 239 240 IF NOT (A.ALL ** IDENT_INT(2) = IDENT_INT(100)) THEN 241 FAILED ("IMPROPER VALUE FROM EXPONENTIATION"); 242 END IF; 243 244 IF NOT (+A.ALL = IDENT_INT(10)) THEN 245 FAILED ("IMPROPER VALUE FROM IDENTITY"); 246 END IF; 247 248 IF NOT (-A.ALL = IDENT_INT(-10)) THEN 249 FAILED ("IMPROPER VALUE FROM NEGATION"); 250 END IF; 251 252 A := NULL; 253 254 IF A /= NULL THEN 255 FAILED ("IMPROPER VALUE FROM ACCESS SET TO NULL"); 256 END IF; 257 258 IF A'ADDRESS NOT IN ADDRESS THEN 259 FAILED ("IMPROPER RESULT FROM A'ADDRESS TEST"); 260 END IF; 261 262 263 DECLARE 264 ACC_SIZE : INTEGER := ACC'SIZE; 265 BEGIN 266 IF ACC_SIZE NOT IN INTEGER THEN 267 FAILED ("IMPROPER RESULT FROM ACC'SIZE"); 268 END IF; 269 END; 270 271 R := NEW REC'(COMP => 5); 272 273 IF NOT EQUAL(R.COMP,5) THEN 274 FAILED ("IMPROPER VALUE FOR RECORD COMPONENT"); 275 END IF; 276 277 DR := NEW DISCREC'(DISC => 1, COMPD => 5); 278 279 IF NOT EQUAL(DR.DISC,1) OR NOT EQUAL(DR.COMPD,5) THEN 280 FAILED ("IMPROPER VALUES FOR DISCRIMINATED RECORD " & 281 "COMPONENTS"); 282 END IF; 283 284 C := NEW ARR'(1 => (1,2), 2 => (3,4)); 285 286 IF C(1,1) /= 1 OR C(1,2) /= 2 OR C(2,1) /= 3 OR C(2,2) /= 4 287 THEN FAILED ("IMPROPER ARRAY COMPONENT VALUES"); 288 END IF; 289 290 D := NEW ONEDIM'(1,2,3,4,5,6,7,8,9,10); 291 E := NEW ONEDIM'(10,9,8,7,6,5,4,3,2,1); 292 293 D(1..5) := E(1..5); 294 295 IF D(1) /= 10 OR D(2) /= 9 OR D(3) /= 8 296 OR D(4) /= 7 OR D(5) /= 6 THEN 297 FAILED ("IMPROPER RESULTS FROM SLICE ASSIGNMENT"); 298 END IF; 299 300 IF C'FIRST /= 1 OR C'FIRST(2) /= 1 THEN 301 FAILED ("IMPROPER LOWER BOUNDS FOR CONSTRAINED ARRAY"); 302 END IF; 303 304 IF C'LAST /= 2 OR C'LAST(2) /= 2 THEN 305 FAILED ("IMPROPER UPPER BOUNDS FOR CONSTRAINED ARRAY"); 306 END IF; 307 308 IF 1 NOT IN C'RANGE THEN 309 FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 1"); 310 END IF; 311 312 IF 1 NOT IN C'RANGE(2) THEN 313 FAILED ("IMPROPER RANGE FOR CONSTRAINED ARRAY - 2"); 314 END IF; 315 316 IF C'LENGTH /= 2 THEN 317 FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " & 318 "ARRAY - 1"); 319 END IF; 320 321 IF C'LENGTH(2) /= 2 THEN 322 FAILED ("IMPROPER NUMBER OF VALUES FOR CONSTRAINED " & 323 "ARRAY - 2"); 324 END IF; 325 326 F := NEW T; 327 328 F.HERE(INT); 329 330 IF NOT EQUAL(INT,IDENT_INT(10)) THEN 331 FAILED ("IMPROPER RESULTS FROM ENTRY SELECTION"); 332 END IF; 333 334 G := NEW T1; 335 336 G.HERE1(TWO)(INT); 337 338 IF NOT EQUAL(INT,IDENT_INT(20)) THEN 339 FAILED ("IMPROPER RESULTS FROM FAMILY ENTRY SELECTION"); 340 END IF; 341 342 RESULT; 343 END P; 344 345 PACKAGE PACK IS NEW P(INTEGER,ACCINTEGER,AI,AREC,ADISCREC, 346 AA,AONEDIM,ATASK,ATASK1,ANOTHERTASK); 347 348BEGIN 349 NULL; 350END CC1225A; 351