1-- C43208B.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-- FOR AN AGGREGATE OF THE FORM: 26-- (B..C => (D..E => (F..G => (H..I => J)))) 27-- WHOSE TYPE IS A TWO-DIMENSIONAL ARRAY TYPE THAT HAS A TWO- 28-- DIMENSIONAL ARRAY COMPONENT TYPE, CHECK THAT: 29 30-- A) IF B..C OR D..E IS A NULL RANGE, THEN F, G, H, I, AND J 31-- ARE NOT EVALUATED. 32 33-- B) IF B..C AND D..E ARE NON-NULL RANGES, THEN F, G, H AND I 34-- ARE EVALUATED (C-B+1)*(E-D+1) TIMES, AND J IS EVALUATED 35-- (C-B+1)*(E-D+1)*(G-F+1)*(I-H+1) TIMES IF F..G AND H..I 36-- ARE NON-NULL. 37 38-- EG 01/19/84 39 40WITH REPORT; 41 42PROCEDURE C43208B IS 43 44 USE REPORT; 45 46BEGIN 47 48 TEST("C43208B", "CHECK THAT THE EVALUATION OF A MULTI" & 49 "DIMENSIONAL ARRAY TYPE THAT HAS AN " & 50 "ARRAY COMPONENT TYPE IS PERFORMED " & 51 "CORRECTLY"); 52 53 DECLARE 54 55 TYPE CHOICE_INDEX IS (B, C, D, E, F, G, H, I, J); 56 TYPE CHOICE_CNTR IS ARRAY(CHOICE_INDEX) OF INTEGER; 57 58 CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0); 59 60 TYPE T1 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>) 61 OF INTEGER; 62 63 FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER) 64 RETURN INTEGER IS 65 BEGIN 66 CNTR(A) := CNTR(A) + 1; 67 RETURN IDENT_INT(B); 68 END CALC; 69 70 BEGIN 71 72CASE_A : BEGIN 73 74 CASE_A1 : DECLARE 75 A1 : ARRAY(4 .. 3, 3 .. 4) OF T1(2 .. 3, 1 .. 2); 76 BEGIN 77 CNTR := (CHOICE_INDEX => 0); 78 A1 := (4 .. 3 => (3 .. 4 => 79 (CALC(F,2) .. CALC(G,3) => 80 (CALC(H,1) .. CALC(I,2) => CALC(J,2))))); 81 IF CNTR(F) /= 0 THEN 82 FAILED("CASE A1 : F WAS EVALUATED"); 83 END IF; 84 IF CNTR(G) /= 0 THEN 85 FAILED("CASE A1 : G WAS EVALUATED"); 86 END IF; 87 IF CNTR(H) /= 0 THEN 88 FAILED("CASE A1 : H WAS EVALUATED"); 89 END IF; 90 IF CNTR(I) /= 0 THEN 91 FAILED("CASE A1 : I WAS EVALUATED"); 92 END IF; 93 IF CNTR(J) /= 0 THEN 94 FAILED("CASE A1 : J WAS EVALUATED"); 95 END IF; 96 EXCEPTION 97 WHEN OTHERS => 98 FAILED("CASE A1 : EXCEPTION RAISED"); 99 END CASE_A1; 100 101 CASE_A2 : DECLARE 102 A2 : ARRAY(3 .. 4, 4 .. 3) OF T1(2 .. 3, 1 .. 2); 103 BEGIN 104 CNTR := (CHOICE_INDEX => 0); 105 A2 := (CALC(B,3) .. CALC(C,4) => 106 (CALC(D,4) .. CALC(E,3) => 107 (CALC(F,2) .. CALC(G,3) => 108 (CALC(H,1) .. CALC(I,2) => CALC(J,2))))); 109 IF CNTR(F) /= 0 THEN 110 FAILED("CASE A2 : F WAS EVALUATED"); 111 END IF; 112 IF CNTR(G) /= 0 THEN 113 FAILED("CASE A2 : G WAS EVALUATED"); 114 END IF; 115 IF CNTR(H) /= 0 THEN 116 FAILED("CASE A2 : H WAS EVALUATED"); 117 END IF; 118 IF CNTR(I) /= 0 THEN 119 FAILED("CASE A2 : I WAS EVALUATED"); 120 END IF; 121 IF CNTR(J) /= 0 THEN 122 FAILED("CASE A2 : J WAS EVALUATED"); 123 END IF; 124 EXCEPTION 125 WHEN OTHERS => 126 FAILED("CASE A2 : EXCEPTION RAISED"); 127 END CASE_A2; 128 129 END CASE_A; 130 131CASE_B : BEGIN 132 133 CASE_B1 : DECLARE 134 B1 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10); 135 BEGIN 136 CNTR := (CHOICE_INDEX => 0); 137 B1 := (2 .. 3 => (1 .. 2 => 138 (CALC(F,1) .. CALC(G,2) => 139 (CALC(H,9) .. CALC(I,10) => CALC(J,2))))); 140 IF CNTR(F) /= 4 THEN 141 FAILED("CASE B1 : F NOT EVALUATED (C-B+1)*" & 142 "(E-D+1) TIMES"); 143 END IF; 144 IF CNTR(G) /= 4 THEN 145 FAILED("CASE B1 : G NOT EVALUATED (C-B+1)*" & 146 "(E-D+1) TIMES"); 147 END IF; 148 IF CNTR(H) /= 4 THEN 149 FAILED("CASE B1 : H NOT EVALUATED (C-B+1)*" & 150 "(E-D+1) TIMES"); 151 END IF; 152 IF CNTR(I) /= 4 THEN 153 FAILED("CASE B1 : I NOT EVALUATED (C-B+1)*" & 154 "(E-D+1) TIMES"); 155 END IF; 156 IF CNTR(J) /= 16 THEN 157 FAILED("CASE B1 : J NOT EVALUATED (C-B+1)*" & 158 "(E-D+1)*(G-F+1)*(I-H+1) TIMES"); 159 END IF; 160 EXCEPTION 161 WHEN OTHERS => 162 FAILED("CASE B1 : EXECEPTION RAISED"); 163 END CASE_B1; 164 165 CASE_B2 : DECLARE 166 B2 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10); 167 BEGIN 168 CNTR := (CHOICE_INDEX => 0); 169 B2 := (CALC(B,2) .. CALC(C,3) => 170 (CALC(D,1) .. CALC(E,2) => 171 (CALC(F,1) .. CALC(G,2) => 172 (CALC(H,9) .. CALC(I,10) => CALC(J,2))))); 173 IF CNTR(F) /= 4 THEN 174 FAILED("CASE B2 : F NOT EVALUATED (C-B+1)*" & 175 "(E-D+1) TIMES"); 176 END IF; 177 IF CNTR(G) /= 4 THEN 178 FAILED("CASE B2 : G NOT EVALUATED (C-B+1)*" & 179 "(E-D+1) TIMES"); 180 END IF; 181 IF CNTR(H) /= 4 THEN 182 FAILED("CASE B2 : H NOT EVALUATED (C-B+1)*" & 183 "(E-D+1) TIMES"); 184 END IF; 185 IF CNTR(I) /= 4 THEN 186 FAILED("CASE B2 : I NOT EVALUATED (C-B+1)*" & 187 "(E-D+1) TIMES"); 188 END IF; 189 IF CNTR(J) /= 16 THEN 190 FAILED("CASE B2 : J NOT EVALUATED (C-B+1)*" & 191 "(E-D+1)*(G-F+1)*(I-H+1) TIMES"); 192 END IF; 193 EXCEPTION 194 WHEN OTHERS => 195 FAILED("CASE B2 : EXECEPTION RAISED"); 196 END CASE_B2; 197 198 CASE_B3 : DECLARE 199 B3 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 2 .. 1); 200 BEGIN 201 CNTR := (CHOICE_INDEX => 0); 202 B3 := (2 .. 3 => (1 .. 2 => 203 (CALC(F,1) .. CALC(G,2) => 204 (CALC(H,2) .. CALC(I,1) => CALC(J,2))))); 205 IF CNTR(F) /= 4 THEN 206 FAILED("CASE B3 : F NOT EVALUATED (C-B+1)*" & 207 "(E-D+1) TIMES"); 208 END IF; 209 IF CNTR(G) /= 4 THEN 210 FAILED("CASE B3 : G NOT EVALUATED (C-B+1)*" & 211 "(E-D+1) TIMES"); 212 END IF; 213 IF CNTR(H) /= 4 THEN 214 FAILED("CASE B3 : H NOT EVALUATED (C-B+1)*" & 215 "(E-D+1) TIMES"); 216 END IF; 217 IF CNTR(I) /= 4 THEN 218 FAILED("CASE B3 : I NOT EVALUATED (C-B+1)*" & 219 "(E-D+1) TIMES"); 220 END IF; 221 IF CNTR(J) /= 0 THEN 222 FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES"); 223 END IF; 224 EXCEPTION 225 WHEN OTHERS => 226 FAILED("CASE B3 : EXECEPTION RAISED"); 227 END CASE_B3; 228 229 CASE_B4 : DECLARE 230 B4 : ARRAY(2 .. 3, 1 .. 2) OF T1(2 .. 1, 1 .. 2); 231 BEGIN 232 CNTR := (CHOICE_INDEX => 0); 233 B4 := (CALC(B,2) .. CALC(C,3) => 234 (CALC(D,1) .. CALC(E,2) => 235 (CALC(F,2) .. CALC(G,1) => 236 (CALC(H,1) .. CALC(I,2) => CALC(J,2))))); 237 IF CNTR(F) /= 4 THEN 238 FAILED("CASE B4 : F NOT EVALUATED (C-B+1)*" & 239 "(E-D+1) TIMES"); 240 END IF; 241 IF CNTR(G) /= 4 THEN 242 FAILED("CASE B4 : G NOT EVALUATED (C-B+1)*" & 243 "(E-D+1) TIMES"); 244 END IF; 245 IF CNTR(H) /= 4 THEN 246 FAILED("CASE B4 : H NOT EVALUATED (C-B+1)*" & 247 "(E-D+1) TIMES"); 248 END IF; 249 IF CNTR(I) /= 4 THEN 250 FAILED("CASE B4 : I NOT EVALUATED (C-B+1)*" & 251 "(E-D+1) TIMES"); 252 END IF; 253 IF CNTR(J) /= 0 THEN 254 FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES"); 255 END IF; 256 EXCEPTION 257 WHEN OTHERS => 258 FAILED("CASE B4 : EXECEPTION RAISED"); 259 END CASE_B4; 260 261 END CASE_B; 262 END; 263 264 RESULT; 265 266END C43208B; 267