1-- C45282A.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 IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
26--     A) ACCESS TO SCALAR TYPES;
27--     B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED);
28--     C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT
29--        DISCRIMINANTS;
30
31-- TBN  8/8/86
32
33WITH REPORT; USE REPORT;
34PROCEDURE C45282A IS
35
36     PACKAGE P IS
37          TYPE KEY IS PRIVATE;
38          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
39          TYPE NEWKEY IS LIMITED PRIVATE;
40          TYPE ACC_NKEY IS ACCESS NEWKEY;
41          PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY);
42     PRIVATE
43          TYPE KEY IS NEW NATURAL;
44          TYPE NEWKEY IS NEW KEY;
45     END P;
46
47     USE P;
48     SUBTYPE I IS INTEGER;
49     TYPE ACC_INT IS ACCESS I;
50     P_INT : ACC_INT;
51     SUBTYPE INT IS INTEGER RANGE 1 .. 5;
52     TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER;
53     TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1;
54     SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2);
55     SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3);
56     ARA1 : ACC_ARA_1;
57     ARA2 : ACC_ARA_2;
58     ARA3 : ACC_ARA_3;
59     TYPE GREET IS
60          RECORD
61               NAME : STRING (1 .. 2);
62          END RECORD;
63     TYPE ACC_GREET IS ACCESS GREET;
64     INTRO : ACC_GREET;
65     TYPE ACC_KEY IS ACCESS KEY;
66     KEY1 : ACC_KEY;
67     KEY2 : ACC_NKEY;
68
69     PACKAGE BODY P IS
70          FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
71          BEGIN
72               RETURN (KEY(X));
73          END INIT_KEY;
74
75          PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS
76          BEGIN
77               Y.ALL := NEWKEY (1);
78          END ASSIGN_NEWKEY;
79     END P;
80
81BEGIN
82
83     TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
84                      "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " &
85                      "RECORD TYPES, PRIVATE TYPES, AND LIMITED " &
86                      "PRIVATE TYPES WITHOUT DISCRIMINANTS");
87
88-- CASE A
89     IF P_INT NOT IN ACC_INT THEN
90          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
91     END IF;
92     P_INT := NEW INT'(5);
93     IF P_INT IN ACC_INT THEN
94          NULL;
95     ELSE
96          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
97     END IF;
98
99-- CASE B
100     IF ARA1 NOT IN ACC_ARA_1 THEN
101          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
102     END IF;
103     IF ARA1 NOT IN ACC_ARA_2 THEN
104          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
105     END IF;
106     IF ARA1 IN ACC_ARA_3 THEN
107          NULL;
108     ELSE
109          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
110     END IF;
111     IF ARA2 IN ACC_ARA_1 THEN
112          NULL;
113     ELSE
114          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
115     END IF;
116     IF ARA3 NOT IN ACC_ARA_1 THEN
117          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
118     END IF;
119     ARA1 := NEW ARRAY_TYPE1'(1, 2, 3);
120     IF ARA1 IN ACC_ARA_1 THEN
121          NULL;
122     ELSE
123          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
124     END IF;
125     IF ARA1 IN ACC_ARA_2 THEN
126          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
127     END IF;
128     IF ARA1 NOT IN ACC_ARA_3 THEN
129          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
130     END IF;
131     ARA2 := NEW ARRAY_TYPE1'(1, 2);
132     IF ARA2 NOT IN ACC_ARA_1 THEN
133          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
134     END IF;
135     IF ARA2 NOT IN ACC_ARA_2 THEN
136          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
137     END IF;
138
139-- CASE C
140     IF INTRO NOT IN ACC_GREET THEN
141          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
142     END IF;
143     INTRO := NEW GREET'(NAME => "HI");
144     IF INTRO IN ACC_GREET THEN
145          NULL;
146     ELSE
147          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
148     END IF;
149     IF KEY1 NOT IN ACC_KEY THEN
150          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
151     END IF;
152     KEY1 := NEW KEY'(INIT_KEY (1));
153     IF KEY1 IN ACC_KEY THEN
154          NULL;
155     ELSE
156          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
157     END IF;
158     IF KEY2 NOT IN ACC_NKEY THEN
159          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
160     END IF;
161     KEY2 := NEW NEWKEY;
162     ASSIGN_NEWKEY (KEY2);
163     IF KEY2 IN ACC_NKEY THEN
164          NULL;
165     ELSE
166          FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
167     END IF;
168
169     RESULT;
170END C45282A;
171