1-- C37405A.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 WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED
26-- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT
27-- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED
28-- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.
29
30-- ASL 7/21/81
31-- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS
32--                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND
33--                 RECORD COMPONENTS.
34
35WITH REPORT; USE REPORT;
36PROCEDURE C37405A IS
37
38     TYPE REC(DISC : INTEGER := 25) IS
39          RECORD
40               COMP : INTEGER;
41          END RECORD;
42
43     SUBTYPE CONSTR IS REC(10);
44     SUBTYPE UNCONSTR IS REC;
45
46     TYPE REC_C IS
47          RECORD
48               COMP: CONSTR;
49          END RECORD;
50
51     TYPE REC_U IS
52          RECORD
53               COMP: UNCONSTR;
54          END RECORD;
55
56     C1,C2 : CONSTR;
57     U1,U2 : UNCONSTR;
58-- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.
59
60     ARR_C : ARRAY (1..5) OF CONSTR;
61     ARR_U : ARRAY (1..5) OF UNCONSTR;
62
63     REC_COMP_C : REC_C;
64     REC_COMP_U : REC_U;
65
66     PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
67     BEGIN
68          PARM := C2;
69          IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
70               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
71                       "ASSIGNMENT - 1");
72          END IF;
73     END PROC11;
74
75     PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
76     BEGIN
77          PARM := U2;
78          IF B /= PARM'CONSTRAINED THEN
79               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
80                       "ASSIGNMENT - 2");
81          END IF;
82     END PROC12;
83
84     PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
85     BEGIN
86          IF B /= PARM'CONSTRAINED THEN
87               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
88                       "PASSING PARAMETER");
89          END IF;
90
91          PROC11(PARM, B);
92
93          PROC12(PARM, B);
94
95     END PROC1;
96
97     PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
98     BEGIN
99          COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.
100          PROC1(PARM,TRUE);
101          PARM := U2;
102          IF NOT PARM'CONSTRAINED THEN
103               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
104                       "ASSIGNMENT - 3");
105          END IF;
106     END PROC2;
107BEGIN
108     TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
109                     "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
110
111     C2 := (DISC => IDENT_INT(10), COMP => 3);
112     U2 := (DISC => IDENT_INT(10), COMP => 4);
113
114     ARR_C := (1..5 => U2);
115     ARR_U := (1..5 => C2);
116
117     REC_COMP_C := (COMP => U2);
118     REC_COMP_U := (COMP => C2);
119
120     C1 := U2;
121     U1 := C2;
122
123     IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
124          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
125     END IF;
126
127     IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
128          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
129     END IF;
130
131     IF REC_COMP_U.COMP'CONSTRAINED
132         OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
133          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
134     END IF;
135
136     COMMENT("CALLING PROC1 DIRECTLY");
137     PROC1(C1,TRUE);
138     PROC2(C1);
139
140     COMMENT("CALLING PROC1 DIRECTLY");
141     PROC1(U1,FALSE);
142     PROC2(U1);
143
144     COMMENT("CALLING PROC1 DIRECTLY");
145     PROC1(ARR_C(4), TRUE);
146     PROC2(ARR_C(5));
147
148     COMMENT("CALLING PROC1 DIRECTLY");
149     PROC1(ARR_U(2), FALSE);
150     PROC2(ARR_U(3));
151
152     COMMENT("CALLING PROC1 DIRECTLY");
153     PROC1(REC_COMP_C.COMP, TRUE);
154     PROC2(REC_COMP_C.COMP);
155
156     COMMENT("CALLING PROC1 DIRECTLY");
157     PROC1(REC_COMP_U.COMP, FALSE);
158     PROC2(REC_COMP_U.COMP);
159
160     RESULT;
161END C37405A;
162