1--C37404A.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-- OBJECTIVE:
26--     CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES DECLARED WITH A
27--     CONSTRAINED TYPE, FOR CONSTANT OBJECTS (EVEN IF NOT DECLARED
28--     WITH A CONSTRAINED TYPE), AND DESIGNATED OBJECTS.
29
30-- HISTORY:
31--     DHH 02/25/88 CREATED ORIGINAL TEST.
32
33WITH REPORT; USE REPORT;
34PROCEDURE C37404A IS
35
36     SUBTYPE INT IS INTEGER RANGE 1 .. 10;
37     TYPE REC(A : INT) IS
38          RECORD
39               I : INT;
40     END RECORD;
41
42     TYPE ACC_REC IS ACCESS REC(4);
43     TYPE ACC_REC1 IS ACCESS REC;
44     SUBTYPE REC4 IS REC(4);
45     SUBTYPE REC5 IS REC;
46
47     TYPE REC_DEF(A : INT := 5) IS
48          RECORD
49               I : INT := 1;
50     END RECORD;
51
52     TYPE ACC_DEF IS ACCESS REC_DEF(4);
53     TYPE ACC_DEF1 IS ACCESS REC_DEF;
54     SUBTYPE REC6 IS REC_DEF(6);
55     SUBTYPE REC7 IS REC_DEF;
56
57     A : REC4 := (A => 4, I => 1);                    -- CONSTRAINED.
58     B : REC5(4) := (A => 4, I => 1);                 -- CONSTRAINED.
59     C : REC6;                                        -- CONSTRAINED.
60     D : REC7(6);                                     -- CONSTRAINED.
61     E : ACC_REC1(4);                                 -- CONSTRAINED.
62     F : ACC_DEF1(4);                                 -- CONSTRAINED.
63     G : ACC_REC1;                                    -- UNCONSTRAINED.
64     H : ACC_DEF1;                                    -- UNCONSTRAINED.
65
66     R : REC(5) := (A => 5, I => 1);                  -- CONSTRAINED.
67     T : REC_DEF(5);                                  -- CONSTRAINED.
68     U : ACC_REC;                                     -- CONSTRAINED.
69     V : ACC_DEF;                                     -- CONSTRAINED.
70     W : CONSTANT REC(5) := (A => 5, I => 1);         -- CONSTANT.
71     X : CONSTANT REC := (A => 5, I => 1);            -- CONSTANT.
72     Y : CONSTANT REC_DEF(5) := (A => 5, I => 1);     -- CONSTANT.
73     Z : CONSTANT REC_DEF := (A => 5, I => 1);        -- CONSTANT.
74
75BEGIN
76     TEST("C37404A", "CHECK THAT 'CONSTRAINED IS TRUE FOR VARIABLES " &
77                     "DECLARED WITH A  CONSTRAINED TYPE, FOR " &
78                     "CONSTANT OBJECTS (EVEN IF NOT DECLARED WITH A " &
79                     "CONSTRAINED TYPE), AND DESIGNATED OBJECTS");
80
81     U := NEW REC(4);
82     V := NEW REC_DEF(4);
83     E := NEW REC(4);
84     F := NEW REC_DEF(4);
85     G := NEW REC(4);                                 -- CONSTRAINED.
86     H := NEW REC_DEF(4);                             -- CONSTRAINED.
87
88     IF NOT A'CONSTRAINED THEN
89          FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE1");
90     END IF;
91
92     IF NOT B'CONSTRAINED THEN
93          FAILED("'CONSTRAINED NOT TRUE FOR SUBTYPE2");
94     END IF;
95
96     IF NOT C'CONSTRAINED THEN
97          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE1");
98     END IF;
99
100     IF NOT D'CONSTRAINED THEN
101          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT SUBTYPE2");
102     END IF;
103
104     IF NOT R'CONSTRAINED THEN
105          FAILED("'CONSTRAINED NOT TRUE FOR RECORD COMPONENT");
106     END IF;
107
108     IF NOT T'CONSTRAINED THEN
109          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT VARIABLE");
110     END IF;
111
112     IF NOT E.ALL'CONSTRAINED THEN
113          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 1");
114     END IF;
115
116     IF NOT F.ALL'CONSTRAINED THEN
117          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 1");
118     END IF;
119
120     IF NOT G.ALL'CONSTRAINED THEN
121          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 2");
122     END IF;
123
124     IF NOT H.ALL'CONSTRAINED THEN
125          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 2");
126     END IF;
127
128     IF NOT U.ALL'CONSTRAINED THEN
129          FAILED("'CONSTRAINED NOT TRUE FOR ACCESS 3");
130     END IF;
131
132     IF NOT V.ALL'CONSTRAINED THEN
133          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT ACCESS 3");
134     END IF;
135
136     IF NOT W'CONSTRAINED THEN
137          FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, CONSTRAINED");
138     END IF;
139
140     IF NOT X'CONSTRAINED THEN
141          FAILED("'CONSTRAINED NOT TRUE FOR CONSTANT, UNCONSTRAINED");
142     END IF;
143
144     IF NOT Y'CONSTRAINED THEN
145          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
146                 "CONSTRAINED");
147     END IF;
148
149     IF NOT Z'CONSTRAINED THEN
150          FAILED("'CONSTRAINED NOT TRUE FOR DEFAULT CONSTANT, " &
151                 "UNCONSTRAINED");
152     END IF;
153
154     IF IDENT_INT(T.I) /= 1 OR
155        IDENT_INT(C.I) /= 1 OR
156        IDENT_INT(D.I) /= 1 OR
157        IDENT_INT(W.A) /= 5 OR
158        IDENT_INT(X.A) /= 5 OR
159        IDENT_INT(Y.A) /= 5 OR
160        IDENT_INT(Z.I) /= 1 OR
161        IDENT_INT(A.I) /= 1 OR
162        IDENT_INT(B.I) /= 1 OR
163        IDENT_BOOL(R.I /= 1) THEN
164             FAILED("INCORRECT INITIALIZATION VALUES");
165     END IF;
166
167     RESULT;
168END C37404A;
169