| -- C45282A.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- CHECK THAT IN AND NOT IN ARE EVALUATED CORRECTLY FOR : |
| -- A) ACCESS TO SCALAR TYPES; |
| -- B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED); |
| -- C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT |
| -- DISCRIMINANTS; |
| |
| -- TBN 8/8/86 |
| |
| WITH REPORT; USE REPORT; |
| PROCEDURE C45282A IS |
| |
| PACKAGE P IS |
| TYPE KEY IS PRIVATE; |
| FUNCTION INIT_KEY (X : NATURAL) RETURN KEY; |
| TYPE NEWKEY IS LIMITED PRIVATE; |
| TYPE ACC_NKEY IS ACCESS NEWKEY; |
| PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY); |
| PRIVATE |
| TYPE KEY IS NEW NATURAL; |
| TYPE NEWKEY IS NEW KEY; |
| END P; |
| |
| USE P; |
| SUBTYPE I IS INTEGER; |
| TYPE ACC_INT IS ACCESS I; |
| P_INT : ACC_INT; |
| SUBTYPE INT IS INTEGER RANGE 1 .. 5; |
| TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER; |
| TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1; |
| SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2); |
| SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3); |
| ARA1 : ACC_ARA_1; |
| ARA2 : ACC_ARA_2; |
| ARA3 : ACC_ARA_3; |
| TYPE GREET IS |
| RECORD |
| NAME : STRING (1 .. 2); |
| END RECORD; |
| TYPE ACC_GREET IS ACCESS GREET; |
| INTRO : ACC_GREET; |
| TYPE ACC_KEY IS ACCESS KEY; |
| KEY1 : ACC_KEY; |
| KEY2 : ACC_NKEY; |
| |
| PACKAGE BODY P IS |
| FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS |
| BEGIN |
| RETURN (KEY(X)); |
| END INIT_KEY; |
| |
| PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS |
| BEGIN |
| Y.ALL := NEWKEY (1); |
| END ASSIGN_NEWKEY; |
| END P; |
| |
| BEGIN |
| |
| TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " & |
| "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " & |
| "RECORD TYPES, PRIVATE TYPES, AND LIMITED " & |
| "PRIVATE TYPES WITHOUT DISCRIMINANTS"); |
| |
| -- CASE A |
| IF P_INT NOT IN ACC_INT THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1"); |
| END IF; |
| P_INT := NEW INT'(5); |
| IF P_INT IN ACC_INT THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2"); |
| END IF; |
| |
| -- CASE B |
| IF ARA1 NOT IN ACC_ARA_1 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3"); |
| END IF; |
| IF ARA1 NOT IN ACC_ARA_2 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4"); |
| END IF; |
| IF ARA1 IN ACC_ARA_3 THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5"); |
| END IF; |
| IF ARA2 IN ACC_ARA_1 THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6"); |
| END IF; |
| IF ARA3 NOT IN ACC_ARA_1 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7"); |
| END IF; |
| ARA1 := NEW ARRAY_TYPE1'(1, 2, 3); |
| IF ARA1 IN ACC_ARA_1 THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8"); |
| END IF; |
| IF ARA1 IN ACC_ARA_2 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9"); |
| END IF; |
| IF ARA1 NOT IN ACC_ARA_3 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10"); |
| END IF; |
| ARA2 := NEW ARRAY_TYPE1'(1, 2); |
| IF ARA2 NOT IN ACC_ARA_1 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11"); |
| END IF; |
| IF ARA2 NOT IN ACC_ARA_2 THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12"); |
| END IF; |
| |
| -- CASE C |
| IF INTRO NOT IN ACC_GREET THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13"); |
| END IF; |
| INTRO := NEW GREET'(NAME => "HI"); |
| IF INTRO IN ACC_GREET THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14"); |
| END IF; |
| IF KEY1 NOT IN ACC_KEY THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15"); |
| END IF; |
| KEY1 := NEW KEY'(INIT_KEY (1)); |
| IF KEY1 IN ACC_KEY THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16"); |
| END IF; |
| IF KEY2 NOT IN ACC_NKEY THEN |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17"); |
| END IF; |
| KEY2 := NEW NEWKEY; |
| ASSIGN_NEWKEY (KEY2); |
| IF KEY2 IN ACC_NKEY THEN |
| NULL; |
| ELSE |
| FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18"); |
| END IF; |
| |
| RESULT; |
| END C45282A; |