3 -- Grant of Unlimited Rights
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
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.
26 -- CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS
27 -- ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL
28 -- PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER,
29 -- AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A
30 -- SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A
31 -- DERIVED TYPE DEFINITION.
34 -- BCB 08/04/88 CREATED ORIGINAL TEST.
36 WITH REPORT
; USE REPORT
;
41 TYPE X
(L
: INTEGER) IS PRIVATE;
46 TEST
("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " &
47 "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " &
48 "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " &
49 "AS THE TYPE OF A GENERIC FORMAL OBJECT " &
50 "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " &
51 "IN A MEMBERSHIP TEST, IN A SUBTYPE " &
52 "DECLARATION, IN AN ACCESS TYPE DEFINITION, " &
53 "AND IN A DERIVED TYPE DEFINITION");
56 TYPE REC
(D
: INTEGER := 3) IS RECORD
61 TYPE R
(D
: INTEGER) IS PRIVATE;
72 TYPE ACC_R
IS ACCESS R
;
76 BOOL
: BOOLEAN := (OBJ
IN R
);
80 ACC_VAR
: ACC_R
:= NEW R
(5);
84 PACKAGE NEW_PACK
IS NEW PACK
(R
);
87 REC_VAR
: REC
(5) := (D
=> 5);
90 PROCEDURE S
(X
: R
) IS
92 IF NOT EQUAL
(X
.D
,5) THEN
93 FAILED
("WRONG DISCRIMINANT VALUE - S");
100 IF NOT EQUAL
(Y
.D
,5) THEN
101 FAILED
("WRONG DISCRIMINANT VALUE - T");
106 IF NOT EQUAL
(OBJ
.D
,5) THEN
107 FAILED
("IMPROPER DISCRIMINANT VALUE");
114 IF NOT EQUAL
(SUB_VAR
.D
,5) THEN
115 FAILED
("IMPROPER DISCRIMINANT VALUE - SUBTYPE");
118 IF NOT EQUAL
(ACC_VAR
.D
,5) THEN
119 FAILED
("IMPROPER DISCRIMINANT VALUE - ACCESS");
122 IF NOT EQUAL
(NEW_VAR
.D
,5) THEN
123 FAILED
("IMPROPER DISCRIMINANT VALUE - DERIVED");
127 FAILED
("IMPROPER RESULT FROM MEMBERSHIP TEST");
131 PACKAGE NEW_P
IS NEW P
(REC
,REC_VAR
);