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 -- FOR A CONSTRAINED IN FORMAL PARAMETER HAVING A RECORD OR PRIVATE
27 -- TYPE WITH DISCRIMINANTS, CHECK THAT CONSTRAINT_ERROR IS RAISED
28 -- IF AND ONLY IF CORRESPONDING DISCRIMINANTS OF THE ACTUAL AND
29 -- FORMAL PARAMETER DO NOT HAVE THE SAME VALUES.
32 -- LB 12/04/86 CREATED ORIGINAL TEST.
33 -- VCL 08/19/87 CORRECTED THE FORMAT OF THIS HEADER.
35 WITH REPORT
; USE REPORT
;
39 TYPE INT
IS RANGE 1 .. 20;
42 TEST
("CC3127A","CORRESPONDING DISCRIMINANTS OF THE GENERIC "&
43 "ACTUAL PARAMETER AND THE GENERIC FORMAL "&
44 "PARAMETER MUST HAVE THE SAME VALUES.");
51 SUBTYPE CON_REC
IS REC
(4);
56 NREC
: CON_REC
:= GREC
;
62 PACKAGE AB
IS NEW PA
(RVAR
);
64 FAILED
("EXCEPTION NOT RAISED 1");
65 AB
.NREC
.RINT
:= IDENT_INT
(AB
.NREC
.RINT
);
68 WHEN CONSTRAINT_ERROR
=>
71 FAILED
("WRONG EXCEPTION RAISED 1");
77 PACKAGE CD
IS NEW PA
(SVAR
);
80 CD
.NREC
.RINT
:= IDENT_INT
(CD
.NREC
.RINT
);
85 FAILED
("EXCEPTION RAISED 2");
91 TYPE PRI_REC
(G
: INT
) IS PRIVATE;
93 TYPE PRI_REC
(G
: INT
) IS
98 SUBTYPE CPRI_REC
IS EF
.PRI_REC
(4);
101 GEN_REC
: IN CPRI_REC
;
103 NGEN_REC
: CPRI_REC
:= GEN_REC
;
109 PVAR
: EF
.PRI_REC
(4);
110 PACKAGE LM
IS NEW GH
(PVAR
);
113 LM
.NGEN_REC
:= LM
.NGEN_REC
;
118 FAILED
("EXCEPTION RAISED 3");
123 PTVAR
: EF
.PRI_REC
(5);
124 PACKAGE PAC
IS NEW GH
(PTVAR
);
126 FAILED
("EXCEPTION NOT RAISED 4");
128 COMMENT
("DISCRIMINANT OF PAC.NGEN_REC IS "&
129 INT
'IMAGE(PAC
.NGEN_REC
.G
));
133 WHEN CONSTRAINT_ERROR
=>
136 FAILED
("WRONG EXCEPTION RAISED 4");