1-- C45112B.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 THE BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION
26-- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL
27-- ARRAYS.
28
29-- RJW 2/3/86
30
31WITH REPORT; USE REPORT;
32
33PROCEDURE C45112B IS
34
35     TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
36     A1 : ARR(IDENT_INT(4) .. IDENT_INT(3));
37     A2 : ARR(IDENT_INT(2) .. IDENT_INT(1));
38     SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
39
40     PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
41     BEGIN
42          IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
43               FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
44          END IF;
45     END CHECK;
46
47BEGIN
48
49     TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
50                       "ARRAY OPERATIONS ON NULL ARRAYS" );
51
52     BEGIN
53          DECLARE
54               AAND : CONSTANT ARR := A1 AND A2;
55               AOR  : CONSTANT ARR := A1 OR A2;
56               AXOR : CONSTANT ARR := A1 XOR A2;
57          BEGIN
58               CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ",
59                            "'AND'" );
60
61               CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ",
62                            "'OR'" );
63
64               CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ",
65                            "'XOR'" );
66          END;
67     EXCEPTION
68          WHEN CONSTRAINT_ERROR =>
69               FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
70                        "INTIALIZATIONS" );
71          WHEN OTHERS =>
72               FAILED ( "OTHER EXCEPTION RAISED DURING " &
73                        "INITIALIZATIONS" );
74     END;
75
76     DECLARE
77          PROCEDURE PROC (A : ARR; STR : STRING) IS
78          BEGIN
79               CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY",
80                      STR);
81          END PROC;
82     BEGIN
83          PROC ((A1 AND A2), "'AND'" );
84          PROC ((A1 OR A2), "'OR'" );
85          PROC ((A1 XOR A2), "'XOR'" );
86     EXCEPTION
87          WHEN OTHERS =>
88               FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
89                        "PARAMETERS" );
90     END;
91
92     DECLARE
93          FUNCTION FUNCAND RETURN ARR IS
94          BEGIN
95               RETURN A1 AND A2;
96          END FUNCAND;
97
98          FUNCTION FUNCOR RETURN ARR IS
99          BEGIN
100               RETURN A1 OR A2;
101          END FUNCOR;
102
103          FUNCTION FUNCXOR RETURN ARR IS
104          BEGIN
105               RETURN A1 XOR A2;
106          END FUNCXOR;
107
108     BEGIN
109          CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
110          CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
111          CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
112
113     EXCEPTION
114          WHEN OTHERS =>
115               FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
116                        "FROM FUNCTION" );
117     END;
118
119     BEGIN
120          DECLARE
121               GENERIC
122                   X : IN ARR;
123               PACKAGE PKG IS
124                    FUNCTION G RETURN ARR;
125               END PKG;
126
127               PACKAGE BODY PKG IS
128                    FUNCTION G RETURN ARR IS
129                    BEGIN
130                         RETURN X;
131                    END G;
132               END PKG;
133
134               PACKAGE PAND IS NEW PKG(X => A1 AND A2);
135               PACKAGE POR IS NEW PKG(X => A1 OR A2);
136               PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
137          BEGIN
138               CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
139               CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
140               CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
141          END;
142     EXCEPTION
143          WHEN OTHERS =>
144               FAILED ( "EXCEPTION RAISED DURING GENERIC " &
145                        "INSTANTIATION" );
146     END;
147
148     DECLARE
149          TYPE ACC IS ACCESS ARR;
150          AC : ACC;
151
152     BEGIN
153          AC :=  NEW ARR'(A1 AND A2);
154          CHECK (AC.ALL, "ALLOCATION", "'AND'");
155          AC :=  NEW ARR'(A1 OR A2);
156          CHECK (AC.ALL, "ALLOCATION", "'OR'");
157          AC :=  NEW ARR'(A1 XOR A2);
158          CHECK (AC.ALL, "ALLOCATION", "'XOR'");
159     EXCEPTION
160          WHEN OTHERS =>
161               FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
162     END;
163
164     BEGIN
165          CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
166          CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
167          CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
168     EXCEPTION
169          WHEN OTHERS =>
170               FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
171     END;
172
173     DECLARE
174          TYPE REC IS
175               RECORD
176                    RCA : CARR;
177               END RECORD;
178          R1 : REC;
179
180     BEGIN
181          R1 := (RCA => (A1 AND A2));
182          CHECK (R1.RCA, "AGGREGATE", "'AND'");
183          R1 := (RCA => (A1 OR A2));
184          CHECK (R1.RCA, "AGGREGATE", "'OR'");
185          R1 := (RCA => (A1 XOR A2));
186          CHECK (R1.RCA, "AGGREGATE", "'XOR'");
187     EXCEPTION
188          WHEN OTHERS =>
189               FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
190     END;
191
192     BEGIN
193          DECLARE
194               TYPE RECDEF IS
195                    RECORD
196                         RCDF1 : CARR := A1 AND A2;
197                         RCDF2 : CARR := A1 OR A2;
198                         RCDF3 : CARR := A1 XOR A2;
199                    END RECORD;
200               RD : RECDEF;
201          BEGIN
202               CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
203               CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
204               CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
205          EXCEPTION
206               WHEN OTHERS =>
207                    FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
208          END;
209     EXCEPTION
210          WHEN OTHERS =>
211               FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
212                        "DEFAULT RECORD" );
213     END;
214
215     DECLARE
216          PROCEDURE PDEF (X : CARR := A1 AND A2;
217                          Y : CARR := A1 OR A2;
218                          Z : CARR := A1 XOR A2 ) IS
219          BEGIN
220               CHECK (X, "DEFAULT PARAMETER", "'AND'");
221               CHECK (Y, "DEFAULT PARAMETER", "'OR'");
222               CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
223          END PDEF;
224
225     BEGIN
226          PDEF;
227     EXCEPTION
228          WHEN OTHERS =>
229               FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
230     END;
231
232     RESULT;
233
234END C45112B;
235