1-- C45274C.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 )
26--     YIELDS  TRUE  (RESP.  FALSE ) IF THE DISCRIMINANTS OF THE LEFT
27--     VALUE EQUAL THE DISCRIMINANTS OF THE SUBTYPE INDICATION.
28--
29--
30--   * RECORD TYPES WITH DISCRIMINANTS;
31--   * PRIVATE TYPES WITH DISCRIMINANTS;
32--   * LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
33
34
35-- RM  3/01/82
36
37
38WITH REPORT;
39USE REPORT;
40PROCEDURE C45274C IS
41
42
43BEGIN
44
45     TEST ( "C45274C" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
46                        "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
47                        " IF THE DISCRIMINANTS OF THE LEFT VALUE" &
48                        " EQUAL THE DISCRIMINANTS OF THE SUBTYPE" &
49                        " INDICATION" );
50
51
52     -------------------------------------------------------------------
53     -----------------  RECORD TYPES WITH DISCRIMINANTS  ---------------
54
55     DECLARE
56
57          TYPE  REC ( DISCR : BOOLEAN := FALSE ) IS
58               RECORD
59                    A , B : INTEGER ;
60               END RECORD ;
61
62          SUBTYPE  RECTRUE  IS REC(TRUE) ;
63
64          X : REC  :=  ( TRUE , 19 , 91 );
65
66     BEGIN
67
68          IF  X  IN  RECTRUE  THEN
69               NULL;
70          ELSE
71               FAILED( "WRONG VALUE: 'IN', 1" );
72          END IF;
73
74          IF  X  NOT IN  RECTRUE  THEN
75               FAILED( "WRONG VALUE: 'NOT IN', 1" );
76          ELSE
77               NULL;
78          END IF;
79
80     EXCEPTION
81
82          WHEN  OTHERS =>
83               FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
84
85     END;
86
87
88     -------------------------------------------------------------------
89     -----------------  PRIVATE TYPES WITH DISCRIMINANTS  --------------
90
91     DECLARE
92
93          PACKAGE  P  IS
94               TYPE  PRIV ( DISCR : BOOLEAN ) IS PRIVATE;
95          PRIVATE
96               TYPE  PRIV ( DISCR : BOOLEAN ) IS
97                    RECORD
98                         A , B : INTEGER ;
99                    END RECORD ;
100          END  P ;
101
102          USE  P ;
103
104          SUBTYPE  PRIVTRUE  IS  PRIV( IDENT_BOOL(TRUE) );
105
106          X : PRIV(TRUE) ;
107
108          PACKAGE BODY  P  IS
109          BEGIN
110               X := ( TRUE , 19 , 91 );
111          END  P ;
112
113     BEGIN
114
115          IF  X  IN  PRIVTRUE  THEN
116               NULL;
117          ELSE
118               FAILED( "WRONG VALUE: 'IN', 2" );
119          END IF;
120
121          IF  X  NOT IN  PRIVTRUE  THEN
122               FAILED( "WRONG VALUE: 'NOT IN', 2" );
123          ELSE
124               NULL;
125          END IF;
126
127     EXCEPTION
128
129          WHEN  OTHERS =>
130               FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
131
132     END;
133
134     -------------------------------------------------------------------
135     ---------  LIMITED PRIVATE TYPES WITH DISCRIMINANTS  --------------
136
137     DECLARE
138
139          PACKAGE  P  IS
140               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS LIMITED PRIVATE;
141          PRIVATE
142               TYPE  LP ( DISCR : BOOLEAN := FALSE ) IS
143                    RECORD
144                         A , B : INTEGER ;
145                    END RECORD ;
146          END  P ;
147
148          USE  P ;
149
150          SUBTYPE  LPFALSE  IS  LP(FALSE) ;
151
152          X : LP(TRUE) ;
153
154          PACKAGE BODY  P  IS
155          BEGIN
156               X := ( IDENT_BOOL(TRUE) , 19 , 91 );
157          END  P ;
158
159     BEGIN
160
161          IF  X  IN  LPFALSE  THEN
162               FAILED( "WRONG VALUE: 'IN', 3" );
163          ELSE
164               NULL;
165          END IF;
166
167          IF  X  NOT IN  LPFALSE  THEN
168               NULL;
169          ELSE
170               FAILED( "WRONG VALUE: 'NOT IN', 3" );
171          END IF;
172
173     EXCEPTION
174
175          WHEN  OTHERS =>
176               FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
177
178     END;
179
180
181     -------------------------------------------------------------------
182
183
184     RESULT;
185
186
187END  C45274C ;
188