1-- C37010B.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 EXPRESSIONS IN AN INDEX CONSTRAINT OR DISCRIMINANT
26-- CONSTRAINT ARE EVALUATED WHEN THE COMPONENT DECLARATION IS
27-- ELABORATED EVEN IF SOME BOUNDS OR DISCRIMINANTS ARE GIVEN BY
28-- A DISCRIMINANT OF AN ENCLOSING RECORD TYPE.
29
30-- R.WILLIAMS 8/22/86
31
32WITH REPORT; USE REPORT;
33PROCEDURE C37010B IS
34
35     INIT :INTEGER := IDENT_INT (5);
36
37     TYPE R (D1, D2 : INTEGER) IS
38          RECORD
39               NULL;
40          END RECORD;
41
42     TYPE ACCR IS ACCESS R;
43
44     TYPE ARR IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
45
46     TYPE ACCA IS ACCESS ARR;
47
48     FUNCTION RESET (N : INTEGER) RETURN INTEGER IS
49     BEGIN
50          INIT := IDENT_INT (N);
51          RETURN N;
52     END RESET;
53
54BEGIN
55     TEST ( "C37010B", "CHECK THAT EXPRESSIONS IN AN INDEX " &
56                       "CONSTRAINT OR DISCRIMINANT CONSTRAINT " &
57                       "ARE EVALUATED WHEN THE COMPONENT " &
58                       "DECLARATION IS ELABORATED EVEN IF SOME " &
59                       "BOUNDS OR DISCRIMINANTS ARE GIVEN BY " &
60                       "A DISCRIMINANT OF AN ENCLOSING RECORD TYPE" );
61
62     DECLARE
63
64          TYPE REC1 (D : INTEGER) IS
65               RECORD
66                    W1 : R (D1 => INIT, D2 => D);
67                    X1 : ARR (INIT .. D);
68                    Y1 : ACCR (D, INIT);
69                    Z1 : ACCA (D .. INIT);
70               END RECORD;
71
72          INT1 : INTEGER := RESET (10);
73
74          R1 : REC1 (D => 4);
75
76     BEGIN
77          IF R1.W1.D1 /= 5 THEN
78               FAILED ( "INCORRECT VALUE FOR R1.W1.D1" );
79          END IF;
80
81          IF R1.W1.D2 /= 4 THEN
82               FAILED ( "INCORRECT VALUE FOR R1.W1.D2" );
83          END IF;
84
85          IF R1.X1'FIRST /= 5 THEN
86               FAILED ( "INCORRECT VALUE FOR R1.X1'FIRST" );
87          END IF;
88
89          IF R1.X1'LAST /= 4 THEN
90               FAILED ( "INCORRECT VALUE FOR R1.X1'LAST" );
91          END IF;
92
93          BEGIN
94               R1.Y1 := NEW R (4, 5);
95          EXCEPTION
96               WHEN OTHERS =>
97                    FAILED ( "INCORRECT VALUE FOR R1.Y1" );
98          END;
99
100          BEGIN
101               R1.Z1 := NEW ARR (4 .. 5);
102          EXCEPTION
103               WHEN OTHERS =>
104                    FAILED ( "INCORRECT VALUE FOR R1.Z1" );
105          END;
106
107     END;
108
109     DECLARE
110
111          TYPE REC2 (D : INTEGER) IS
112               RECORD
113                    CASE D IS
114                         WHEN 1 =>
115                              NULL;
116                         WHEN 2 =>
117                              NULL;
118                         WHEN OTHERS =>
119                              W2 : R (D1 => D, D2 => INIT);
120                              X2 : ARR (D .. INIT);
121                              Y2 : ACCR (INIT, D);
122                              Z2 : ACCA (D .. INIT);
123                    END CASE;
124               END RECORD;
125
126          INT2 : INTEGER := RESET (20);
127
128          R2 : REC2 (D => 6);
129
130     BEGIN
131          IF R2.W2.D1 /= 6 THEN
132               FAILED ( "INCORRECT VALUE FOR R2.W2.D1" );
133          END IF;
134
135          IF R2.W2.D2 /= 10 THEN
136               FAILED ( "INCORRECT VALUE FOR R2.W2.D2" );
137          END IF;
138
139          IF R2.X2'FIRST /= 6 THEN
140               FAILED ( "INCORRECT VALUE FOR R2.X2'FIRST" );
141          END IF;
142
143          IF R2.X2'LAST /= 10 THEN
144               FAILED ( "INCORRECT VALUE FOR R2.X2'LAST" );
145          END IF;
146
147          BEGIN
148               R2.Y2 := NEW R (10, 6);
149          EXCEPTION
150               WHEN OTHERS =>
151                    FAILED ( "INCORRECT VALUE FOR R2.Y2" );
152          END;
153
154          BEGIN
155               R2.Z2 := NEW ARR (6 .. 10);
156          EXCEPTION
157               WHEN OTHERS =>
158                    FAILED ( "INCORRECT VALUE FOR R2.Z2" );
159          END;
160
161     END;
162
163     RESULT;
164END C37010B;
165