1-- C52104A.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 A : STATICALLY-DETERMINABLE NON-NULL LENGTHS. 33 34 35-- RM 07/20/81 36-- SPS 3/22/83 37 38WITH REPORT; 39PROCEDURE C52104A IS 40 41 USE REPORT ; 42 43BEGIN 44 45 TEST( "C52104A" , "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 DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI- 137 -- VISIONS C (FOR NON-NULL ARRAYS) AND D (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( 1..5 , 0..7 ); 160 SUBTYPE TABOX02 IS TABOX0( 0..5 , 2..9 ); 161 162 ARRX01 : TABOX01 ; 163 ARRX02 : TABOX02 ; 164 165 BEGIN 166 167 -- INITIALIZATION OF RHS ARRAY: 168 169 FOR I IN 1..5 LOOP 170 171 FOR J IN 0..7 LOOP 172 ARRX01( I , J ) := I * I * J ; 173 END LOOP; 174 175 END LOOP; 176 177 178 -- INITIALIZATION OF LHS ARRAY: 179 180 FOR I IN 0..5 LOOP 181 182 FOR J IN 2..9 LOOP 183 ARRX02( I , J ) := I * I * J * 3 ; 184 END LOOP; 185 186 END LOOP; 187 188 189 -- ARRAY ASSIGNMENT: 190 191 ARRX02 := ARRX01 ; 192 FAILED( "EXCEPTION NOT RAISED - SUBTEST 10" ); 193 194 EXCEPTION 195 196 WHEN CONSTRAINT_ERROR => 197 198 -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT: 199 200 FOR I IN 0..5 LOOP 201 202 FOR J IN 2..9 LOOP 203 204 IF ARRX02( I , J ) /= I * I * J * 3 205 THEN 206 FAILED( "ORIG. VALUE ALTERED (10)" ); 207 END IF; 208 209 END LOOP; 210 211 END LOOP; 212 213 WHEN OTHERS => 214 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 10" ); 215 216 END ; 217 218 219 ------------------------------------------------------------------- 220 221 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 222 -- WERE DEFINED USING THE "BOX" SYMBOL 223 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 224 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.) 225 226 DECLARE 227 228 TYPE TABOX1 IS ARRAY( INTEGER RANGE <> ) OF INTEGER ; 229 230 SUBTYPE TABOX11 IS TABOX1( 1..5 ) ; 231 232 ARRX11 : TABOX11 ; 233 ARRX12 : TABOX1( 6..9 ); 234 235 BEGIN 236 237 -- INITIALIZATION OF RHS ARRAY: 238 239 FOR I IN 1..5 LOOP 240 241 ARRX11( I ) := I * I ; 242 243 END LOOP; 244 245 246 -- INITIALIZATION OF LHS ARRAY: 247 248 FOR I IN 6..9 LOOP 249 ARRX12( I ) := I * I * 3 ; 250 END LOOP; 251 252 253 -- ARRAY ASSIGNMENT: 254 255 ARRX12 := ARRX11 ; 256 FAILED( "EXCEPTION NOT RAISED - SUBTEST 11" ); 257 258 EXCEPTION 259 260 WHEN CONSTRAINT_ERROR => 261 262 -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT: 263 264 FOR I IN 6..9 LOOP 265 266 IF ARRX12( I ) /= I * I * 3 267 THEN 268 FAILED( "ORIG. VALUE ALTERED (11)" ); 269 END IF; 270 271 END LOOP; 272 273 WHEN OTHERS => 274 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 11" ); 275 276 END ; 277 278 279 ------------------------------------------------------------------- 280 281 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 282 -- WERE DEFINED USING THE "BOX" SYMBOL 283 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 284 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) 285 286 DECLARE 287 288 TYPE TABOX5 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN ; 289 290 SUBTYPE TABOX51 IS TABOX5( 1..5 ); 291 292 ARRX51 : TABOX51 ; 293 ARRX52 : TABOX5( 5..9 ); 294 295 BEGIN 296 297 -- INITIALIZATION OF LHS ARRAY: 298 299 FOR I IN 5..9 LOOP 300 ARRX52( I ) := FALSE ; 301 END LOOP; 302 303 304 -- INITIALIZATION OF RHS ARRAY: 305 306 FOR I IN 1..5 LOOP 307 ARRX51( I ) := TRUE ; 308 END LOOP; 309 310 311 -- SLICE ASSIGNMENT: 312 313 ARRX52(6..9) := ARRX51(3..3) ; 314 FAILED( "EXCEPTION NOT RAISED (12)" ); 315 316 EXCEPTION 317 318 WHEN CONSTRAINT_ERROR => 319 320 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT: 321 322 FOR I IN 5..9 LOOP 323 324 IF ARRX52( I ) /= FALSE 325 THEN 326 FAILED( "LHS ARRAY ALTERED ( 12 ) " ); 327 END IF; 328 329 END LOOP; 330 331 WHEN OTHERS => 332 FAILED( "EXCEPTION RAISED - SUBTEST 12" ); 333 334 END ; 335 336 337 ------------------------------------------------------------------- 338 339 340 RESULT ; 341 342 343END C52104A; 344