1-- C32001B.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-- OBJECTIVE: 26-- CHECK THAT IN MULTIPLE OBJECT DECLARATIONS FOR ARRAY TYPES, THE 27-- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE 28-- EVALUATED ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE 29-- SUBTYPE INDICATION IS EVALUATED FIRST. ALSO, CHECK THAT THE 30-- EVALUATIONS YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT 31-- DECLARATIONS. 32 33-- HISTORY: 34-- RJW 07/16/86 CREATED ORIGINAL TEST. 35-- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. CHANGED 36-- COMMENTS FOR S4 AND CS4 TO READ THAT THE BOUNDS ARE 37-- 1 .. 6 AND THE COMPONENT TYPE ARR IS 1 .. 5. 38 39WITH REPORT; USE REPORT; 40 41PROCEDURE C32001B IS 42 43 TYPE ARR IS ARRAY (NATURAL RANGE <>) OF INTEGER; 44 45 BUMP : ARRAY (1 .. 4) OF INTEGER := (0, 0, 0, 0); 46 47 FUNCTION F (I : INTEGER) RETURN INTEGER IS 48 BEGIN 49 BUMP (I) := BUMP (I) + 1; 50 RETURN BUMP (I); 51 END F; 52 53BEGIN 54 TEST ("C32001B", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " & 55 "FOR ARRAY TYPES, THE SUBTYPE INDICATION " & 56 "AND THE INITIALIZATION EXPRESSIONS ARE " & 57 "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " & 58 "IS DECLARED AND THE SUBTYPE INDICATION IS " & 59 "EVALUATED FIRST. ALSO, CHECK THAT THE " & 60 "EVALUATIONS YIELD THE SAME RESULT AS A " & 61 "SEQUENCE OF SINGLE OBJECT DECLARATIONS" ); 62 63 DECLARE 64 65 S1, S2 : ARR (1 .. F (1)) := (OTHERS => F (1)); 66 CS1, CS2 : CONSTANT ARR (1 .. F (2)) := (OTHERS => F (2)); 67 68 PROCEDURE CHECK (A, B : ARR; STR1, STR2 : STRING) IS 69 BEGIN 70 IF A'LAST /= 1 THEN 71 FAILED ( "INCORRECT UPPER BOUND FOR " & STR1 ); 72 END IF; 73 74 IF A (1) /= 2 THEN 75 FAILED ( "INCORRECT INITIAL VALUE FOR " & STR1 ); 76 END IF; 77 78 IF B'LAST /= 3 THEN 79 FAILED ( "INCORRECT UPPER BOUND FOR " & STR2 ); 80 END IF; 81 82 BEGIN 83 IF B (1 .. 3) = (4, 5, 6) THEN 84 COMMENT ( STR2 & " WAS INITIALIZED TO " & 85 "(4, 5, 6)" ); 86 ELSIF B (1 .. 3) = (5, 4, 6) THEN 87 COMMENT ( STR2 & " WAS INITIALIZED TO " & 88 "(5, 4, 6)" ); 89 ELSIF B (1 .. 3) = (4, 6, 5) THEN 90 COMMENT ( STR2 & " WAS INITIALIZED TO " & 91 "(4, 6, 5)" ); 92 ELSIF B (1 .. 3) = (6, 4, 5) THEN 93 COMMENT ( STR2 & " WAS INITIALIZED TO " & 94 "(6, 4, 5)" ); 95 ELSIF B (1 .. 3) = (6, 5, 4) THEN 96 COMMENT ( STR2 & " WAS INITIALIZED TO " & 97 "(6, 5, 4)" ); 98 ELSIF B (1 .. 3) = (5, 6, 4) THEN 99 COMMENT ( STR2 & " WAS INITIALIZED TO " & 100 "(5, 6, 4)" ); 101 ELSE 102 FAILED ( STR2 & " HAS INCORRECT INITIAL " & 103 "VALUE" ); 104 END IF; 105 EXCEPTION 106 WHEN CONSTRAINT_ERROR => 107 FAILED ( "CONSTRAINT_ERROR RAISED - " & 108 STR2 ); 109 WHEN OTHERS => 110 FAILED ( "EXCEPTION RAISED - " & 111 STR2 ); 112 END; 113 END; 114 115 BEGIN 116 CHECK (S1, S2, "S1", "S2"); 117 CHECK (CS1, CS2, "CS1", "CS2"); 118 END; 119 120 DECLARE 121 122 S3, S4 : ARRAY (1 .. F (3)) OF ARR (1 .. F (3)) := 123 (OTHERS => (OTHERS => F (3))); 124 125 CS3, CS4 : CONSTANT ARRAY (1.. F (4)) OF 126 ARR (1 .. F (4)) := 127 (OTHERS => (OTHERS => F (4))); 128 BEGIN 129 IF S3'LAST = 1 THEN 130 IF S3 (1)'LAST = 2 THEN 131 COMMENT ( "S3 HAS BOUNDS 1 .. 1 AND " & 132 "COMPONENT TYPE ARR (1 .. 2)" ); 133 IF S3 (1)(1 .. 2) = (3, 4) THEN 134 COMMENT ( "S3 HAS INITIAL VALUES " & 135 "3 AND 4 - 1" ); 136 ELSIF S3 (1)(1 .. 2) = (4, 3) THEN 137 COMMENT ( "S3 HAS INITIAL VALUES " & 138 "4 AND 3 - 1" ); 139 ELSE 140 FAILED ( "S3 HAS WRONG INITIAL VALUES - 1" ); 141 END IF; 142 ELSE 143 FAILED ( "S3 HAS WRONG COMPONENT TYPE - 1" ); 144 END IF; 145 ELSIF S3'LAST = 2 THEN 146 IF S3 (1)'LAST = 1 THEN 147 COMMENT ( "S3 HAS BOUNDS 1 .. 2 AND " & 148 "COMPONENT TYPE ARR (1 .. 1)" ); 149 IF S3 (1) (1) = 3 AND S3 (2) (1) = 4 THEN 150 COMMENT ( "S3 HAS INITIAL VALUES " & 151 "3 AND 4 - 2" ); 152 ELSIF S3 (1) (1) = 4 AND S3 (2) (1) = 3 THEN 153 COMMENT ( "S3 HAS INITIAL VALUES " & 154 "4 AND 3 - 2" ); 155 ELSE 156 FAILED ( "S3 HAS WRONG INITIAL VALUES - 2" ); 157 END IF; 158 ELSE 159 FAILED ( "S3 HAS WRONG COMPONENT TYPE - 2" ); 160 END IF; 161 ELSE 162 FAILED ( "S3 HAS INCORRECT BOUNDS" ); 163 END IF; 164 165 IF S4'LAST = 5 THEN 166 IF S4 (1)'LAST = 6 THEN 167 COMMENT ( "S4 HAS BOUNDS 1 .. 5 AND " & 168 "COMPONENT TYPE ARR (1 .. 6)" ); 169 ELSE 170 FAILED ( "S4 HAS WRONG COMPONENT TYPE - 1" ); 171 END IF; 172 ELSIF S4'LAST = 6 THEN 173 IF S4 (1)'FIRST = 1 AND S4 (1)'LAST = 5 THEN 174 COMMENT ( "S4 HAS BOUNDS 1 .. 6 AND " & 175 "COMPONENT TYPE ARR (1 .. 5)" ); 176 ELSE 177 FAILED ( "S4 HAS WRONG COMPONENT TYPE - 2" ); 178 END IF; 179 ELSE 180 FAILED ( "S4 HAS INCORRECT BOUNDS" ); 181 END IF; 182 183 IF BUMP (3) /= 36 THEN 184 FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & 185 "TIMES TO INITIALIZE S4" ); 186 END IF; 187 188 IF CS3'FIRST = 1 AND CS3'LAST = 1 THEN 189 IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 2 THEN 190 COMMENT ( "CS3 HAS BOUNDS 1 .. 1 AND " & 191 "COMPONENT TYPE ARR (1 .. 2)" ); 192 IF CS3 (1)(1 .. 2) = (3, 4) THEN 193 COMMENT ( "CS3 HAS INITIAL VALUES " & 194 "3 AND 4 - 1" ); 195 ELSIF CS3 (1)(1 .. 2) = (4, 3) THEN 196 COMMENT ( "CS3 HAS INITIAL VALUES " & 197 "4 AND 3 - 1" ); 198 ELSE 199 FAILED ( "CS3 HAS WRONG INITIAL VALUES - 1" ); 200 END IF; 201 ELSE 202 FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 1" ); 203 END IF; 204 ELSIF CS3'FIRST = 1 AND CS3'LAST = 2 THEN 205 IF CS3 (1)'FIRST = 1 AND CS3 (1)'LAST = 1 THEN 206 COMMENT ( "CS3 HAS BOUNDS 1 .. 2 AND " & 207 "COMPONENT TYPE ARR (1 .. 1)" ); 208 IF CS3 (1) (1) = 3 AND CS3 (2) (1) = 4 THEN 209 COMMENT ( "CS3 HAS INITIAL VALUES " & 210 "3 AND 4 - 2" ); 211 ELSIF CS3 (1) (1) = 4 AND CS3 (2) (1) = 3 THEN 212 COMMENT ( "CS3 HAS INITIAL VALUES " & 213 "4 AND 3 - 2" ); 214 ELSE 215 FAILED ( "CS3 HAS WRONG INITIAL VALUES - 2" ); 216 END IF; 217 ELSE 218 FAILED ( "CS3 HAS WRONG COMPONENT TYPE - 2" ); 219 END IF; 220 ELSE 221 FAILED ( "CS3 HAS INCORRECT BOUNDS" ); 222 END IF; 223 224 IF CS4'FIRST = 1 AND CS4'LAST = 5 THEN 225 IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 6 THEN 226 COMMENT ( "CS4 HAS BOUNDS 1 .. 5 AND " & 227 "COMPONENT TYPE ARR (1 .. 6)" ); 228 ELSE 229 FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 1" ); 230 END IF; 231 ELSIF CS4'FIRST = 1 AND CS4'LAST = 6 THEN 232 IF CS4 (1)'FIRST = 1 AND CS4 (1)'LAST = 5 THEN 233 COMMENT ( "CS4 HAS BOUNDS 1 .. 6 AND " & 234 "COMPONENT TYPE ARR (1 .. 5)" ); 235 ELSE 236 FAILED ( "CS4 HAS WRONG COMPONENT TYPE - 2" ); 237 END IF; 238 ELSE 239 FAILED ( "CS4 HAS INCORRECT BOUNDS" ); 240 END IF; 241 242 IF BUMP (4) /= 36 THEN 243 FAILED ( "FUNCTION F NOT INVOKED CORRECT NUMBER OF " & 244 "TIMES TO INITIALIZE CS4" ); 245 END IF; 246 END; 247 248 RESULT; 249END C32001B; 250