1-- C43208A.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 A ONE-DIMENSIONAL AGGREGATE OF THE FORM (F..G => (H..I => J)), 26-- CHECK THAT: 27 28-- A) IF F..G IS A NULL RANGE, H, I, AND J ARE NOT EVALUATED. 29 30-- B) IF F..G IS A NON-NULL RANGE, H AND I ARE EVALUATED G-F+1 31-- TIMES, AND J IS EVALUATED (I-H+1)*(G-F+1) TIMES IF H..I 32-- IS NON-NULL. 33 34-- EG 01/19/84 35 36WITH REPORT; 37 38PROCEDURE C43208A IS 39 40 USE REPORT; 41 42BEGIN 43 44 TEST("C43208A", "CHECK THAT THE EVALUATION OF A ONE-" & 45 "DIMENSIONAL AGGREGATE OF THE FORM " & 46 "(F..G => (H..I = J)) IS PERFORMED " & 47 "CORRECTLY"); 48 49 DECLARE 50 51 TYPE CHOICE_INDEX IS (F, G, H, I, J); 52 TYPE CHOICE_CNTR IS ARRAY(CHOICE_INDEX) OF INTEGER; 53 54 CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0); 55 56 TYPE T1 IS ARRAY(INTEGER RANGE <>) OF INTEGER; 57 58 FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER) 59 RETURN INTEGER IS 60 BEGIN 61 CNTR(A) := CNTR(A) + 1; 62 RETURN IDENT_INT(B); 63 END CALC; 64 65 BEGIN 66 67CASE_A : BEGIN 68 69 CASE_A1 : DECLARE 70 A1 : ARRAY(4 .. 2) OF T1(1 .. 2); 71 BEGIN 72 CNTR := (CHOICE_INDEX => 0); 73 A1 := (4 .. 2 => 74 (CALC(H,1) .. CALC(I,2) => CALC(J,2))); 75 IF CNTR(H) /= 0 THEN 76 FAILED("CASE A1 : H WAS EVALUATED"); 77 END IF; 78 IF CNTR(I) /= 0 THEN 79 FAILED("CASE A1 : I WAS EVALUATED"); 80 END IF; 81 IF CNTR(J) /= 0 THEN 82 FAILED("CASE A1 : J WAS EVALUATED"); 83 END IF; 84 EXCEPTION 85 WHEN OTHERS => 86 FAILED("CASE A1 : EXCEPTION RAISED"); 87 END CASE_A1; 88 89 CASE_A2 : DECLARE 90 A2 : ARRAY(4 .. 2) OF T1(1 .. 2); 91 BEGIN 92 CNTR := (CHOICE_INDEX => 0); 93 A2 := (CALC(F,4) .. CALC(G,2) => 94 (CALC(H,1) .. CALC(I,2) => CALC(J,2))); 95 IF CNTR(H) /= 0 THEN 96 FAILED("CASE A2 : H WAS EVALUATED"); 97 END IF; 98 IF CNTR(I) /= 0 THEN 99 FAILED("CASE A2 : I WAS EVALUATED"); 100 END IF; 101 IF CNTR(J) /= 0 THEN 102 FAILED("CASE A2 : J WAS EVALUATED"); 103 END IF; 104 EXCEPTION 105 WHEN OTHERS => 106 FAILED("CASE A2 : EXCEPTION RAISED"); 107 END CASE_A2; 108 109 END CASE_A; 110 111CASE_B : BEGIN 112 113 CASE_B1 : DECLARE 114 B1 : ARRAY(2 .. 3) OF T1(1 .. 2); 115 BEGIN 116 CNTR := (CHOICE_INDEX => 0); 117 B1 := (2 .. 3 => 118 (CALC(H,1) .. CALC(I,2) => CALC(J,2))); 119 IF CNTR(H) /= 2 THEN 120 FAILED("CASE B1 : H NOT EVALUATED G-F+1 " & 121 "TIMES"); 122 END IF; 123 IF CNTR(I) /= 2 THEN 124 FAILED("CASE B1 : I NOT EVALUATED G-F+1 " & 125 "TIMES"); 126 END IF; 127 IF CNTR(J) /= 4 THEN 128 FAILED("CASE B1 : J NOT EVALUATED (I-H+1)*" & 129 "(G-F+1) TIMES"); 130 END IF; 131 EXCEPTION 132 WHEN OTHERS => 133 FAILED("CASE B1 : EXECEPTION RAISED"); 134 END CASE_B1; 135 136 CASE_B2 : DECLARE 137 B2 : ARRAY(2 .. 3) OF T1(9 .. 10); 138 BEGIN 139 CNTR := (CHOICE_INDEX => 0); 140 B2 := (CALC(F,2) .. CALC(G,3) => 141 (CALC(H,9) .. CALC(I,10) => CALC(J,2))); 142 IF CNTR(H) /= 2 THEN 143 FAILED("CASE B2 : H NOT EVALUATED G-F+1 " & 144 "TIMES"); 145 END IF; 146 IF CNTR(I) /= 2 THEN 147 FAILED("CASE B2 : I NOT EVALUATED G-F+1 " & 148 "TIMES"); 149 END IF; 150 IF CNTR(J) /= 4 THEN 151 FAILED("CASE B2 : J NOT EVALUATED (I-H+1)*" & 152 "(G-F+1) TIMES"); 153 END IF; 154 EXCEPTION 155 WHEN OTHERS => 156 FAILED("CASE B2 : EXECEPTION RAISED"); 157 END CASE_B2; 158 159 CASE_B3 : DECLARE 160 B3 : ARRAY(2 .. 3) OF T1(2 .. 1); 161 BEGIN 162 CNTR := (CHOICE_INDEX => 0); 163 B3 := (2 .. 3 => 164 (CALC(H,2) .. CALC(I,1) => CALC(J,2))); 165 IF CNTR(H) /= 2 THEN 166 FAILED("CASE B3 : H NOT EVALUATED G-F+1 " & 167 "TIMES"); 168 END IF; 169 IF CNTR(I) /= 2 THEN 170 FAILED("CASE B3 : I NOT EVALUATED G-F+1 " & 171 "TIMES"); 172 END IF; 173 IF CNTR(J) /= 0 THEN 174 FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES"); 175 END IF; 176 EXCEPTION 177 WHEN OTHERS => 178 FAILED("CASE B3 : EXECEPTION RAISED"); 179 END CASE_B3; 180 181 CASE_B4 : DECLARE 182 B4 : ARRAY(2 .. 3) OF T1(2 .. 1); 183 BEGIN 184 CNTR := (CHOICE_INDEX => 0); 185 B4 := (CALC(F,2) .. CALC(G,3) => 186 (CALC(H,2) .. CALC(I,1) => CALC(J,2))); 187 IF CNTR(H) /= 2 THEN 188 FAILED("CASE B4 : H NOT EVALUATED G-F+1 " & 189 "TIMES"); 190 END IF; 191 IF CNTR(I) /= 2 THEN 192 FAILED("CASE B4 : I NOT EVALUATED G-F+1 " & 193 "TIMES"); 194 END IF; 195 IF CNTR(J) /= 0 THEN 196 FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES"); 197 END IF; 198 EXCEPTION 199 WHEN OTHERS => 200 FAILED("CASE B4 : EXECEPTION RAISED"); 201 END CASE_B4; 202 203 END CASE_B; 204 END; 205 206 RESULT; 207 208END C43208A; 209