1-- C52008A.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 A RECORD VARIABLE CONSTRAINED BY A SPECIFIED DISCRIMINANT
26-- VALUE CANNOT HAVE ITS DISCRIMINANT VALUE ALTERED BY ASSIGNMENT.
27-- ASSIGNING AN ENTIRE RECORD VALUE WITH A DIFFERENT DISCRIMINANT VALUE
28-- SHOULD RAISE CONSTRAINT_ERROR AND LEAVE THE TARGET VARIABLE
29-- UNALTERED.  THIS TEST USES STATIC DISCRIMINANT VALUES.
30
31-- ASL 6/25/81
32-- SPS 3/21/83
33
34WITH REPORT;
35PROCEDURE C52008A IS
36
37     USE REPORT;
38
39     TYPE REC(DISC : INTEGER) IS
40          RECORD
41               COMP : INTEGER;
42          END RECORD;
43
44     R : REC(5) := (5,0);
45
46BEGIN
47
48     TEST ("C52008A", "CANNOT ASSIGN RECORD VARIABLE WITH SPECIFIED " &
49                      "DISCRIMINANT VALUE A VALUE WITH A DIFFERENT " &
50                      "STATIC DISCRIMINANT VALUE");
51
52     BEGIN
53          R := (DISC => 5, COMP => 3);
54          IF R /= (5,3) THEN
55               FAILED ("LEGAL ASSIGNMENT FAILED");
56          END IF;
57          R := (DISC => 4, COMP => 2);
58          FAILED ("RECORD ASSIGNED VALUE WITH DIFFERENT DISCRIMINANT " &
59                  "VALUE");
60     EXCEPTION
61          WHEN CONSTRAINT_ERROR =>
62               IF R /= (5,3) THEN
63                    FAILED ("TARGET RECORD VALUE ALTERED BY " &
64                            "ASSIGNMENT TO VALUE WITH DIFFERENT " &
65                            "DISCRIMINANT VALUE EVEN AFTER " &
66                            "CONSTRAINT_ERROR RAISED");
67               END IF;
68          WHEN OTHERS => FAILED ("WRONG EXCEPTION");
69     END;
70
71     RESULT;
72
73END C52008A;
74