1-- C95087A.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-- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY 26-- FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS. 27-- SUBTESTS ARE: 28-- (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS. 29-- (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS. 30-- (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS. 31-- (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS. 32 33-- GLH 7/19/85 34-- JRK 8/23/85 35 36WITH REPORT; USE REPORT; 37PROCEDURE C95087A IS 38 39BEGIN 40 TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " & 41 "UNCONSTRAINED FORMAL PARAMETERS"); 42 43 DECLARE -- (A) 44 45 PACKAGE PKG IS 46 47 SUBTYPE INT IS INTEGER RANGE 0..100; 48 49 TYPE RECTYPE (CONSTRAINT : INT := 80) IS 50 RECORD 51 INTFIELD : INTEGER; 52 STRFIELD : STRING (1..CONSTRAINT); 53 END RECORD; 54 55 REC1 : RECTYPE := (10,10,"0123456789"); 56 REC2 : RECTYPE := (17,7,"C95087A.........."); 57 REC3 : RECTYPE := (1,1,"A"); 58 REC4 : RECTYPE; -- 80. 59 60 TASK T1 IS 61 ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB"); 62 REC2 : OUT RECTYPE; 63 REC3 : IN OUT RECTYPE); 64 END T1; 65 66 TASK T2 IS 67 ENTRY E2 (REC : OUT RECTYPE); 68 END T2; 69 END PKG; 70 71 PACKAGE BODY PKG IS 72 73 TASK BODY T1 IS 74 BEGIN 75 ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB"); 76 REC2 : OUT RECTYPE; 77 REC3 : IN OUT RECTYPE) DO 78 79 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN 80 FAILED ("RECORD TYPE IN PARAMETER " & 81 "DID NOT USE CONSTRAINT " & 82 "OF ACTUAL"); 83 END IF; 84 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN 85 FAILED ("RECORD TYPE OUT " & 86 "PARAMETER DID NOT USE " & 87 "CONSTRAINT OF ACTUAL"); 88 END IF; 89 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN 90 FAILED ("RECORD TYPE IN OUT " & 91 "PARAMETER DID NOT USE " & 92 "CONSTRAINT OF ACTUAL"); 93 END IF; 94 REC2 := PKG.REC2; 95 END E1; 96 END T1; 97 98 TASK BODY T2 IS 99 BEGIN 100 ACCEPT E2 (REC : OUT RECTYPE) DO 101 IF REC.CONSTRAINT /= IDENT_INT (80) THEN 102 FAILED ("RECORD TYPE OUT " & 103 "PARAMETER DID " & 104 "NOT USE CONSTRAINT OF " & 105 "UNINITIALIZED ACTUAL"); 106 END IF; 107 REC := (10,10,"9876543210"); 108 END E2; 109 END T2; 110 END PKG; 111 112 BEGIN -- (A) 113 114 PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3); 115 PKG.T2.E2 (PKG.REC4); 116 117 END; -- (A) 118 119 --------------------------------------------- 120 121B : DECLARE -- (B) 122 123 PACKAGE PKG IS 124 125 SUBTYPE INT IS INTEGER RANGE 0..100; 126 127 TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE; 128 129 130 TASK T1 IS 131 ENTRY E1 (REC1 : IN RECTYPE; 132 REC2 : OUT RECTYPE; 133 REC3 : IN OUT RECTYPE); 134 END T1; 135 136 TASK T2 IS 137 ENTRY E2 (REC : OUT RECTYPE); 138 END T2; 139 140 PRIVATE 141 TYPE RECTYPE (CONSTRAINT : INT := 80) IS 142 RECORD 143 INTFIELD : INTEGER; 144 STRFIELD : STRING (1..CONSTRAINT); 145 END RECORD; 146 END PKG; 147 148 REC1 : PKG.RECTYPE (10); 149 REC2 : PKG.RECTYPE (17); 150 REC3 : PKG.RECTYPE (1); 151 REC4 : PKG.RECTYPE (10); 152 153 PACKAGE BODY PKG IS 154 155 TASK BODY T1 IS 156 BEGIN 157 ACCEPT E1 (REC1 : IN RECTYPE; 158 REC2 : OUT RECTYPE; 159 REC3 : IN OUT RECTYPE) DO 160 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN 161 FAILED ("PRIVATE TYPE IN " & 162 "PARAMETER DID " & 163 "NOT USE CONSTRAINT OF " & 164 "ACTUAL"); 165 END IF; 166 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN 167 FAILED ("PRIVATE TYPE OUT " & 168 "PARAMETER DID " & 169 "NOT USE CONSTRAINT OF " & 170 "ACTUAL"); 171 END IF; 172 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN 173 FAILED ("PRIVATE TYPE IN OUT " & 174 "PARAMETER DID " & 175 "NOT USE CONSTRAINT OF " & 176 "ACTUAL"); 177 END IF; 178 REC2 := B.REC2; 179 END E1; 180 END T1; 181 182 TASK BODY T2 IS 183 BEGIN 184 ACCEPT E2 (REC : OUT RECTYPE) DO 185 IF REC.CONSTRAINT /= IDENT_INT (10) THEN 186 FAILED ("PRIVATE TYPE OUT " & 187 "PARAMETER DID " & 188 "NOT USE CONSTRAINT OF " & 189 "UNINITIALIZED ACTUAL"); 190 END IF; 191 REC := (10,10,"9876543210"); 192 END E2; 193 END T2; 194 195 BEGIN 196 REC1 := (10,10,"0123456789"); 197 REC2 := (17,7,"C95087A.........."); 198 REC3 := (1,1,"A"); 199 END PKG; 200 201 BEGIN -- (B) 202 203 PKG.T1.E1 (REC1, REC2, REC3); 204 PKG.T2.E2 (REC4); 205 206 END B; -- (B) 207 208 --------------------------------------------- 209 210C : DECLARE -- (C) 211 212 PACKAGE PKG IS 213 214 SUBTYPE INT IS INTEGER RANGE 0..100; 215 216 TYPE RECTYPE (CONSTRAINT : INT := 80) IS 217 LIMITED PRIVATE; 218 219 TASK T1 IS 220 ENTRY E1 (REC1 : IN RECTYPE; 221 REC2 : OUT RECTYPE; 222 REC3 : IN OUT RECTYPE); 223 END T1; 224 225 TASK T2 IS 226 ENTRY E2 (REC : OUT RECTYPE); 227 END T2; 228 229 PRIVATE 230 TYPE RECTYPE (CONSTRAINT : INT := 80) IS 231 RECORD 232 INTFIELD : INTEGER; 233 STRFIELD : STRING (1..CONSTRAINT); 234 END RECORD; 235 END PKG; 236 237 REC1 : PKG.RECTYPE; -- 10. 238 REC2 : PKG.RECTYPE; -- 17. 239 REC3 : PKG.RECTYPE; -- 1. 240 REC4 : PKG.RECTYPE; -- 80. 241 242 PACKAGE BODY PKG IS 243 244 TASK BODY T1 IS 245 BEGIN 246 ACCEPT E1 (REC1 : IN RECTYPE; 247 REC2 : OUT RECTYPE; 248 REC3 : IN OUT RECTYPE) DO 249 IF REC1.CONSTRAINT /= IDENT_INT (10) THEN 250 FAILED ("LIMITED PRIVATE TYPE IN " & 251 "PARAMETER DID NOT USE " & 252 "CONSTRAINT OF ACTUAL"); 253 END IF; 254 IF REC2.CONSTRAINT /= IDENT_INT (17) THEN 255 FAILED ("LIMITED PRIVATE TYPE OUT " & 256 "PARAMETER DID NOT USE " & 257 "CONSTRAINT OF " & 258 "ACTUAL"); 259 END IF; 260 IF REC3.CONSTRAINT /= IDENT_INT (1) THEN 261 FAILED ("LIMITED PRIVATE TYPE IN " & 262 "OUT PARAMETER DID NOT " & 263 "USE CONSTRAINT OF ACTUAL"); 264 END IF; 265 REC2 := C.REC2; 266 END E1; 267 END T1; 268 269 TASK BODY T2 IS 270 BEGIN 271 ACCEPT E2 (REC : OUT RECTYPE) DO 272 IF REC.CONSTRAINT /= IDENT_INT (80) THEN 273 FAILED ("LIMITED PRIVATE TYPE OUT " & 274 "PARAMETER DID NOT USE " & 275 "CONSTRAINT OF UNINITIALIZED " & 276 "ACTUAL"); 277 END IF; 278 REC := (10,10,"9876543210"); 279 END E2; 280 END T2; 281 282 BEGIN 283 REC1 := (10,10,"0123456789"); 284 REC2 := (17,7,"C95087A.........."); 285 REC3 := (1,1,"A"); 286 END PKG; 287 288 BEGIN -- (C) 289 290 PKG.T1.E1 (REC1, REC2, REC3); 291 PKG.T2.E2 (REC4); 292 293 END C; -- (C) 294 295 --------------------------------------------- 296 297D : DECLARE -- (D) 298 299 TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF 300 CHARACTER; 301 302 A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'), 303 ('C','D'), 304 ('E','F')); 305 306 A4 : ATYPE (-1..1, 4..5); 307 308 CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) := 309 (8..9 => (-7..INTEGER'FIRST => 'A')); 310 311 S1 : STRING (1..INTEGER'FIRST) := ""; 312 S2 : STRING (-5..-7) := ""; 313 S3 : STRING (1..0) := ""; 314 315 TASK T1 IS 316 ENTRY E1 (A1 : IN ATYPE := CA1; 317 A2 : OUT ATYPE; 318 A3 : IN OUT ATYPE); 319 END T1; 320 321 TASK T2 IS 322 ENTRY E2 (A4 : OUT ATYPE); 323 END T2; 324 325 TASK T3 IS 326 ENTRY E3 (S1 : IN STRING; 327 S2 : IN OUT STRING; 328 S3 : OUT STRING); 329 END T3; 330 331 TASK BODY T1 IS 332 BEGIN 333 ACCEPT E1 (A1 : IN ATYPE := CA1; A2 : OUT ATYPE; 334 A3 : IN OUT ATYPE) DO 335 IF A1'FIRST(1) /= IDENT_INT (-1) OR 336 A1'LAST(1) /= IDENT_INT (1) OR 337 A1'FIRST(2) /= IDENT_INT (4) OR 338 A1'LAST(2) /= IDENT_INT (5) THEN 339 FAILED ("ARRAY TYPE IN PARAMETER DID " & 340 "NOT USE CONSTRAINTS OF ACTUAL"); 341 END IF; 342 IF A2'FIRST(1) /= IDENT_INT (-1) OR 343 A2'LAST(1) /= IDENT_INT (1) OR 344 A2'FIRST(2) /= IDENT_INT (4) OR 345 A2'LAST(2) /= IDENT_INT (5) THEN 346 FAILED ("ARRAY TYPE OUT PARAMETER DID " & 347 "NOT USE CONSTRAINTS OF ACTUAL"); 348 END IF; 349 IF A3'FIRST(1) /= IDENT_INT (-1) OR 350 A3'LAST(1) /= IDENT_INT (1) OR 351 A3'FIRST(2) /= IDENT_INT (4) OR 352 A3'LAST(2) /= IDENT_INT (5) THEN 353 FAILED ("ARRAY TYPE IN OUT PARAMETER " & 354 "DID NOT USE CONSTRAINTS OF " & 355 "ACTUAL"); 356 END IF; 357 A2 := D.A2; 358 END E1; 359 END T1; 360 361 TASK BODY T2 IS 362 BEGIN 363 ACCEPT E2 (A4 : OUT ATYPE) DO 364 IF A4'FIRST(1) /= IDENT_INT (-1) OR 365 A4'LAST(1) /= IDENT_INT (1) OR 366 A4'FIRST(2) /= IDENT_INT (4) OR 367 A4'LAST(2) /= IDENT_INT (5) THEN 368 FAILED ("ARRAY TYPE OUT PARAMETER DID " & 369 "NOT USE CONSTRAINTS OF " & 370 "UNINITIALIZED ACTUAL"); 371 END IF; 372 A4 := A2; 373 END E2; 374 END T2; 375 376 TASK BODY T3 IS 377 BEGIN 378 ACCEPT E3 (S1 : IN STRING; 379 S2 : IN OUT STRING; 380 S3 : OUT STRING) DO 381 IF S1'FIRST /= IDENT_INT (1) OR 382 S1'LAST /= IDENT_INT (INTEGER'FIRST) THEN 383 FAILED ("STRING TYPE IN PARAMETER DID " & 384 "NOT USE CONSTRAINTS OF ACTUAL " & 385 "NULL STRING"); 386 END IF; 387 IF S2'FIRST /= IDENT_INT (-5) OR 388 S2'LAST /= IDENT_INT (-7) THEN 389 FAILED ("STRING TYPE IN OUT PARAMETER " & 390 "DID NOT USE CONSTRAINTS OF " & 391 "ACTUAL NULL STRING"); 392 END IF; 393 IF S3'FIRST /= IDENT_INT (1) OR 394 S3'LAST /= IDENT_INT (0) THEN 395 FAILED ("STRING TYPE OUT PARAMETER DID NOT " & 396 "USE CONSTRAINTS OF ACTUAL NULL " & 397 "STRING"); 398 END IF; 399 S3 := ""; 400 END E3; 401 END T3; 402 403 BEGIN -- (D) 404 405 T1.E1 (A1, A2, A3); 406 T2.E2 (A4); 407 T3.E3 (S1, S2, S3); 408 409 END D; -- (D) 410 411 RESULT; 412END C95087A; 413