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 CONSTRAINT_ERROR IS RAISED AT THE PLACE OF THE CALL
27 -- FOR THE CASE OF A PRIVATE TYPE IMPLEMENTED AS AN ACCESS TYPE WHERE
28 -- THE ACTUAL BOUNDS OR DISCRIMINANTS OF THE DESIGNATED OBJECT DIFFER
29 -- FROM THOSE OF THE FORMAL.
32 -- CPP 7/23/84 CREATED ORIGINAL TEST.
33 -- DHH 8/31/87 ADDED COMMENT IN PROCEDURE Q SO THAT CODE WILL NOT BE
34 -- OPTIMIZED OUT OF EXISTENCE.
37 WITH REPORT
; USE REPORT
;
42 TEST
("C64104O", "CHECK THAT PRIVATE TYPE (ACCESS) RAISES " &
43 "CONSTRAINT_ERROR WHEN ACTUAL AND FORMAL PARAMETER BOUNDS " &
49 CALLED
: BOOLEAN := FALSE;
57 TYPE T
IS ACCESS STRING;
58 DC
: CONSTANT T
:= NEW STRING'("AAA");
61 PROCEDURE Q (X : IN OUT P.T) IS
67 IF P. "=" (X, P.DC) THEN
68 COMMENT("PROCEDURE Q WAS CALLED");
73 FAILED ("EXCEPTION RAISED INSIDE SUBPROGRAM");
87 Z : T(1..5) := NEW STRING'("CCCCC");
89 PACKAGE CALL_Q
IS NEW CALL
(Z
);
96 PACKAGE CALL_Q_NOW
IS NEW P
.PP
;
98 FAILED
("NO EXCEPTION RAISED");
101 WHEN CONSTRAINT_ERROR
=>
103 FAILED
("SUBPROGRAM Q WAS NOT CALLED");
106 FAILED
("WRONG EXCEPTION RAISED");