1-- C43103A.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 IF A DISCRIMINANT DOES NOT GOVERN A VARIANT PART,
26-- ITS VALUE CAN BE GIVEN BY A NON-STATIC EXPRESSION.
27
28-- EG  02/13/84
29
30WITH REPORT;
31
32PROCEDURE C43103A IS
33
34     USE REPORT;
35
36BEGIN
37
38     TEST("C43103A","CHECK THAT IF A DISCRIMINANT DOES NOT GOVERN " &
39                    "A VARIANT PART, ITS VALUE CAN BE GIVEN BY A "  &
40                    "NON-STATIC EXPRESSION");
41
42     BEGIN
43
44          COMMENT ("CASE A : DISCRIMINANT THAT IS NOT USED INSIDE " &
45                   "THE RECORD");
46
47CASE_A :  DECLARE
48
49               TYPE R1 (A : INTEGER) IS
50                    RECORD
51                         B : STRING(1 .. 2);
52                         C : INTEGER;
53                    END RECORD;
54
55               A1 : R1(IDENT_INT(5)) := (IDENT_INT(5), "AB", -2);
56
57          BEGIN
58
59               IF A1.A /= IDENT_INT(5) OR A1.B /= "AB" OR
60                  A1.C /= -2 THEN
61                    FAILED ("CASE A : INCORRECT VALUES IN RECORD");
62               END IF;
63
64          END CASE_A;
65
66          COMMENT ("CASE B : DISCRIMINANT THAT IS USED AS AN ARRAY " &
67                   "INDEX BOUND");
68
69CASE_B :  DECLARE
70
71               SUBTYPE STB IS INTEGER RANGE 1 .. 10;
72               TYPE TB IS ARRAY(STB RANGE <>) OF INTEGER;
73               TYPE R2 (A : STB) IS
74                    RECORD
75                         B : TB(1 .. A);
76                         C : BOOLEAN;
77                    END RECORD;
78
79               B1 : R2(IDENT_INT(2)) := (IDENT_INT(2), (-1, -2), FALSE);
80
81          BEGIN
82
83               IF B1.B'LAST /= IDENT_INT(2) THEN
84                    FAILED ("CASE B : INCORRECT UPPER BOUND");
85               ELSIF B1.A /= IDENT_INT(2) OR B1.B /= (-1, -2) OR
86                     B1.C /= FALSE THEN
87                    FAILED ("CASE B : INCORRECT VALUES IN RECORD");
88               END IF;
89
90          END CASE_B;
91
92          COMMENT ("CASE C : DISCRIMINANT THAT IS USED IN A " &
93                   "DISCRIMINANT CONSTRAINT");
94
95CASE_C :  DECLARE
96
97               SUBTYPE STC IS INTEGER RANGE 1 .. 10;
98               TYPE TC IS ARRAY(STC RANGE <>) OF INTEGER;
99               TYPE R3 (A : STC) IS
100                    RECORD
101                         B : TC(1 .. A);
102                         C : INTEGER := -4;
103                    END RECORD;
104               TYPE R4 (A : INTEGER) IS
105                    RECORD
106                         B : R3(A);
107                         C : INTEGER;
108                    END RECORD;
109
110               C1 : R4(IDENT_INT(3)) := (IDENT_INT(3),
111                                         (IDENT_INT(3), (1, 2, 3), 4),
112                                         5);
113
114          BEGIN
115
116               IF C1.B.B /= (1, 2, 3) OR C1.B.C /= 4 OR
117                  C1.C   /= 5 THEN
118                    FAILED ("CASE C : INCORRECT VALUES IN RECORD");
119               END IF;
120
121          END CASE_C;
122
123     END;
124
125     RESULT;
126
127END C43103A;
128