1-- C45274B.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 THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
26--     YIELDS  TRUE   (RESP.  FALSE )  FOR
27--
28--   * RECORD TYPES WITHOUT DISCRIMINANTS;
29--   * PRIVATE TYPES WITHOUT DISCRIMINANTS;
30--   * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
31-->> * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS;
32-->> * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
33-->> * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
34
35
36-- RM  3/03/82
37
38
39WITH REPORT;
40USE REPORT;
41PROCEDURE C45274B IS
42
43
44BEGIN
45
46     TEST ( "C45274B" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
47                        "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
48                        " FOR UNCONSTRAINED TYPES WITH DISCRIMINANTS" );
49
50
51     -------------------------------------------------------------------
52     --------  UNCONSTRAINED RECORD TYPES WITH DISCRIMINANTS  ----------
53
54     DECLARE
55
56          TYPE  REC ( DISCR : BOOLEAN ) IS
57               RECORD
58                    A , B : INTEGER ;
59               END RECORD ;
60
61          X : REC(FALSE) := ( FALSE , 19 , 81 );
62
63          TYPE  REC0 ( DISCR : BOOLEAN := FALSE ) IS
64               RECORD
65                    A , B : INTEGER ;
66               END RECORD ;
67
68          Y : REC0 := ( TRUE , 19 , 81 );
69
70     BEGIN
71
72          IF  X  IN  REC  THEN
73               NULL;
74          ELSE
75               FAILED( "WRONG VALUE: 'IN', 1A" );
76          END IF;
77
78          IF  Y  NOT IN  REC0  THEN
79               FAILED( "WRONG VALUE: 'NOT IN', 1B" );
80          ELSE
81               NULL;
82          END IF;
83
84     EXCEPTION
85
86          WHEN  OTHERS =>
87               FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
88
89     END;
90
91
92     -------------------------------------------------------------------
93     -------  UNCONSTRAINED PRIVATE TYPES WITH DISCRIMINANTS  ----------
94
95     DECLARE
96
97          PACKAGE  P  IS
98               TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
99          PRIVATE
100               TYPE  PRIV ( DISCR : BOOLEAN ) IS
101                    RECORD
102                         A , B : INTEGER ;
103                    END RECORD ;
104          END  P ;
105
106          USE  P ;
107
108          X : PRIV(FALSE) ;
109
110          PACKAGE BODY  P  IS
111          BEGIN
112               X := ( FALSE , 19 , 91 );
113          END  P ;
114
115     BEGIN
116
117          IF  X  IN  PRIV  THEN
118               NULL;
119          ELSE
120               FAILED( "WRONG VALUE: 'IN', 2" );
121          END IF;
122
123          IF  X  NOT IN  PRIV  THEN
124               FAILED( "WRONG VALUE: 'NOT IN', 2" );
125          ELSE
126               NULL;
127          END IF;
128
129     EXCEPTION
130
131          WHEN  OTHERS =>
132               FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
133
134     END;
135
136
137     -------------------------------------------------------------------
138     ---------  UNCONSTRAINED LIM. PRIV. TYPES WITH DISCRIM.  ----------
139
140     DECLARE
141
142          PACKAGE  P  IS
143               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
144          PRIVATE
145               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
146                    RECORD
147                         A , B : INTEGER ;
148                    END RECORD ;
149          END  P ;
150
151          USE  P ;
152
153          X : LP(TRUE) ;
154
155          PACKAGE BODY  P  IS
156          BEGIN
157               X := ( TRUE , 19 , 91 );
158          END  P ;
159
160     BEGIN
161
162          IF  X  IN  LP  THEN
163               NULL;
164          ELSE
165               FAILED( "WRONG VALUE: 'IN', 3" );
166          END IF;
167
168          IF  X  NOT IN  LP  THEN
169               FAILED( "WRONG VALUE: 'NOT IN', 3" );
170          ELSE
171               NULL;
172          END IF;
173
174     EXCEPTION
175
176          WHEN  OTHERS =>
177               FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
178
179     END;
180
181
182     -------------------------------------------------------------------
183
184     DECLARE
185
186          PACKAGE  P  IS
187               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
188          PRIVATE
189               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
190                    RECORD
191                         A , B : INTEGER ;
192                    END RECORD ;
193          END  P ;
194
195          USE  P ;
196
197          Y : LP(TRUE) ;
198
199     -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
200     BEGIN
201
202          IF  Y  IN  LP  THEN
203               NULL;
204          ELSE
205               FAILED( "WRONG VALUE: 'IN', 3BIS" );
206          END IF;
207
208          IF  Y  NOT IN  LP  THEN
209               FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
210          ELSE
211               NULL;
212          END IF;
213
214     EXCEPTION
215
216          WHEN  OTHERS =>
217               FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
218                       "( 'NOT IN' )  RAISED AN EXCEPTION" );
219
220     END;
221
222
223     -------------------------------------------------------------------
224
225
226     RESULT;
227
228
229END  C45274B ;
230