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