1-- C52104K.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS. 26-- MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN 27-- ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY 28-- INTACT AND CAUSE CONSTRAINT_ERROR TO BE RAISED. 29-- (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT 30-- ARE TREATED ELSEWHERE.) 31 32-- DIVISION C : NON-NULL LENGTHS NOT DETERMINABLE STATICALLY. 33 34 35-- RM 07/20/81 36-- SPS 3/22/83 37 38WITH REPORT; 39PROCEDURE C52104K IS 40 41 USE REPORT ; 42 43BEGIN 44 45 TEST( "C52104K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" & 46 " ASSIGNMENTS THE LENGTHS MUST MATCH" ); 47 48 49 -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN 50 -- THE AGGREGATES ARE STRING LITERALS); THEREFORE: 51 -- 52 -- (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS; 53 -- (2) CAN'T USE NON-NULL CONSTANT ARRAYS. 54 55 56 -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION 57 -- AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL 58 -- ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS 59 -- OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON 60 -- COMPONENT_TYPE. ACCORDINGLY WE ARE TESTING FOR SOME BUT 61 -- NOT ALL KINDS OF COMPONENT_TYPE. (COMPONENT_TYPES INCLUDED: 62 -- INTEGER , CHARACTER , BOOLEAN .) 63 64 65 -- CASES DISTINGUISHED: ( 8 SELECTED CASES ARE IMPLEMENTED) 66 -- 67 -- ( THE 8 SELECTIONS ARE THE 5-CASE 68 -- SERIES 10-11-12-13-14 FOLLOWED 69 -- BY 7 , 8 , 9 (IN THIS ORDER). ) 70 -- 71 -- 72 -- ( EACH DIVISION COMPRISES 3 FILES, 73 -- COVERING RESPECTIVELY THE FIRST 74 -- 3 , NEXT 2 , AND LAST 3 OF THE 8 75 -- SELECTIONS FOR THE DIVISION.) 76 -- 77 -- 78 -- (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT 79 -- THE OBJECTS TO HAVE THE S A M E BASE TYPE.) 80 -- 81 -- 82 -- (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' (BY 83 -- THEMSELVES). 84 -- 85 -- 86 -- (8) SLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' , WITH 87 -- STRING LITERALS. 88 -- 89 -- 90 -- (9) SLICED OBJECTS OF THE PREDEFINED TYPE 'STRING' (BY 91 -- THEMSELVES). 92 -- 93 -- 94 -- (-) CONSTRAINABLE TYPES: ONLY SUBTESTS 2, 3, 4, 5, 6 95 -- WILL BE REPLICATED -- AS SUBTESTS 10, 11, 12, 13, 14 . 96 -- 97 -- 98 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE 99 -- DEFINED USING THE "BOX" COMPOUND SYMBOL. 100 -- (TWO-DIMENSIONAL ARRAYS OF INTEGERS.) 101 -- 102 -- 103 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 104 -- WERE DEFINED USING THE "BOX" SYMBOL 105 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 106 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.) 107 -- 108 -- 109 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 110 -- WERE DEFINED USING THE "BOX" SYMBOL 111 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 112 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) 113 -- 114 -- 115 -- (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 116 -- WERE DEFINED USING THE "BOX" SYMBOL 117 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' . 118 -- 119 -- (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING 120 -- IN THIS TEST. TO FORCE SLIDING, THE LOWER LIMIT IMPLIED 121 -- BY THE TYPEMARK WILL NOT BE 1 .) 122 -- 123 -- 124 -- (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 125 -- WERE DEFINED USING THE "BOX" SYMBOL 126 -- AND FOR WHICH THE COMPONENT TYPE IS 'CHARACTER' . 127 -- 128 -- 129 -- 130 -- (-) SPECIAL CASES: NULL ARRAYS....... TREATED IN DIVISION B. 131 -- SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC 132 -- ARRAYS ONLY, 133 -- DIVISIONS C AND D .) 134 -- 135 -- 136 -- (-) THE STATIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI- 137 -- VISIONS A (FOR NON-NULL ARRAYS) AND B (FOR NULL ARRAYS). 138 -- 139 -- 140 141 142 ------------------------------------------------------------------- 143 144 -- (1..6: NOT APPLICABLE) 145 -- 146 -- 147 148 ------------------------------------------------------------------- 149 150 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE 151 -- DEFINED USING THE "BOX" COMPOUND SYMBOL. 152 -- (TWO-DIMENSIONAL ARRAYS OF INTEGERS.) 153 154 DECLARE 155 156 TYPE TABOX0 IS ARRAY( INTEGER RANGE <> , INTEGER RANGE <> 157 ) OF INTEGER ; 158 159 SUBTYPE TABOX01 IS TABOX0( IDENT_INT(1)..IDENT_INT(5) , 160 IDENT_INT(0)..IDENT_INT(7) ); 161 SUBTYPE TABOX02 IS TABOX0( IDENT_INT(0)..IDENT_INT(5) , 162 IDENT_INT(2)..IDENT_INT(9) ); 163 164 ARRX01 : TABOX01 ; 165 ARRX02 : TABOX02 ; 166 167 BEGIN 168 169 -- INITIALIZATION OF RHS ARRAY: 170 171 FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP 172 173 FOR J IN IDENT_INT(0)..IDENT_INT(7) LOOP 174 ARRX01( I , J ) := I * I * J ; 175 END LOOP; 176 177 END LOOP; 178 179 180 -- INITIALIZATION OF LHS ARRAY: 181 182 FOR I IN IDENT_INT(0)..IDENT_INT(5) LOOP 183 184 FOR J IN IDENT_INT(2)..IDENT_INT(9) LOOP 185 ARRX02( I , J ) := I * I * J * 3 ; 186 END LOOP; 187 188 END LOOP; 189 190 191 -- ARRAY ASSIGNMENT: 192 193 ARRX02 := ARRX01 ; 194 FAILED( "EXCEPTION NOT RAISED - SUBTEST 10" ); 195 196 EXCEPTION 197 198 WHEN CONSTRAINT_ERROR => 199 200 -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT: 201 202 FOR I IN IDENT_INT(0)..IDENT_INT(5) LOOP 203 204 FOR J IN IDENT_INT(2)..IDENT_INT(9) LOOP 205 206 IF ARRX02( I , J ) /= I * I * J * 3 207 THEN 208 FAILED( "ORIG. VALUE ALTERED (10)" ); 209 END IF; 210 211 END LOOP; 212 213 END LOOP; 214 215 WHEN OTHERS => 216 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 10" ); 217 218 END ; 219 220 221 ------------------------------------------------------------------- 222 223 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 224 -- WERE DEFINED USING THE "BOX" SYMBOL 225 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 226 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.) 227 228 DECLARE 229 230 TYPE TABOX1 IS ARRAY( INTEGER RANGE <> ) OF INTEGER ; 231 232 SUBTYPE TABOX11 IS TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ; 233 234 ARRX11 : TABOX11 ; 235 ARRX12 : TABOX1( IDENT_INT(6)..IDENT_INT(9) ); 236 237 BEGIN 238 239 -- INITIALIZATION OF RHS ARRAY: 240 241 FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP 242 243 ARRX11( I ) := I * I ; 244 245 END LOOP; 246 247 248 -- INITIALIZATION OF LHS ARRAY: 249 250 FOR I IN IDENT_INT(6)..IDENT_INT(9) LOOP 251 ARRX12( I ) := I * I * 3 ; 252 END LOOP; 253 254 255 -- ARRAY ASSIGNMENT: 256 257 ARRX12 := ARRX11 ; 258 FAILED( "EXCEPTION NOT RAISED - SUBTEST 11" ); 259 260 EXCEPTION 261 262 WHEN CONSTRAINT_ERROR => 263 264 -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT: 265 266 FOR I IN IDENT_INT(6)..IDENT_INT(9) LOOP 267 268 IF ARRX12( I ) /= I * I * 3 269 THEN 270 FAILED( "ORIG. VALUE ALTERED (11)" ); 271 END IF; 272 273 END LOOP; 274 275 WHEN OTHERS => 276 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 11" ); 277 278 END ; 279 280 281 ------------------------------------------------------------------- 282 283 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 284 -- WERE DEFINED USING THE "BOX" SYMBOL 285 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 286 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) 287 288 DECLARE 289 290 TYPE TABOX5 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN ; 291 292 SUBTYPE TABOX51 IS TABOX5( IDENT_INT(1)..IDENT_INT(5) ); 293 294 ARRX51 : TABOX51 ; 295 ARRX52 : TABOX5( IDENT_INT(5)..IDENT_INT(9) ); 296 297 BEGIN 298 299 -- INITIALIZATION OF LHS ARRAY: 300 301 FOR I IN IDENT_INT(5)..IDENT_INT(9) LOOP 302 ARRX52( I ) := FALSE ; 303 END LOOP; 304 305 306 -- INITIALIZATION OF RHS ARRAY: 307 308 FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP 309 ARRX51( I ) := TRUE ; 310 END LOOP; 311 312 313 -- SLICE ASSIGNMENT: 314 315 ARRX52( IDENT_INT(6)..IDENT_INT(9) ) := 316 ARRX51( 317 IDENT_INT(3)..IDENT_INT(3) ) ; 318 FAILED( "EXCEPTION NOT RAISED (12)" ); 319 320 EXCEPTION 321 322 WHEN CONSTRAINT_ERROR => 323 324 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT: 325 326 FOR I IN IDENT_INT(5)..IDENT_INT(9) LOOP 327 328 IF ARRX52( I ) /= FALSE 329 THEN 330 FAILED( "LHS ARRAY ALTERED ( 12 ) " ); 331 END IF; 332 333 END LOOP; 334 335 WHEN OTHERS => 336 FAILED( "EXCEPTION RAISED - SUBTEST 12" ); 337 338 END ; 339 340 341 ------------------------------------------------------------------- 342 343 344 RESULT ; 345 346 347END C52104K; 348