1-- C52104P.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 D : NULL LENGTHS NOT DETERMINABLE STATICALLY. 33 34 35-- RM 07/20/81 36 37 38WITH REPORT; 39PROCEDURE C52104P IS 40 41 USE REPORT ; 42 43BEGIN 44 45 TEST( "C52104P" , "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: SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC 131 -- ARRAYS ONLY, 132 -- DIVISIONS C AND D .) 133 -- 134 -- 135 136 137 ------------------------------------------------------------------- 138 139 -- (1 .. 6: NOT APPLICABLE) 140 -- 141 -- 142 143 ------------------------------------------------------------------- 144 145 -- (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE 146 -- DEFINED USING THE "BOX" COMPOUND SYMBOL. 147 -- (TWO-DIMENSIONAL ARRAYS OF INTEGERS.) 148 149 DECLARE 150 151 TYPE TABOX0 IS ARRAY( INTEGER RANGE <> , INTEGER RANGE <> 152 ) OF INTEGER ; 153 154 SUBTYPE TABOX01 IS TABOX0( IDENT_INT(1)..IDENT_INT(1) , 155 IDENT_INT(0)..IDENT_INT(7) ); 156 SUBTYPE TABOX02 IS TABOX0 ; 157 158 ARRX01 : TABOX01 ; 159 ARRX02 : TABOX02( IDENT_INT(1)..IDENT_INT(0) , 160 IDENT_INT(0)..IDENT_INT(7) ); 161 162 BEGIN 163 164 -- ARRAY ASSIGNMENT: 165 166 ARRX02 := ARRX01 ; 167 FAILED( "EXCEPTION NOT RAISED - SUBTEST 10" ); 168 169 EXCEPTION 170 171 WHEN CONSTRAINT_ERROR => 172 173 NULL ; 174 175 WHEN OTHERS => 176 177 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 10" ); 178 179 END ; 180 181 182 ------------------------------------------------------------------- 183 184 -- (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 185 -- WERE DEFINED USING THE "BOX" SYMBOL 186 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 187 -- ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.) 188 189 DECLARE 190 191 TYPE TABOX1 IS ARRAY( INTEGER RANGE <> ) OF INTEGER ; 192 193 SUBTYPE TABOX11 IS TABOX1( IDENT_INT(4)..IDENT_INT(5) ) ; 194 195 ARRX11 : TABOX11 ; 196 ARRX12 : TABOX1( IDENT_INT(5)..IDENT_INT(4) ); 197 198 BEGIN 199 200 -- ARRAY ASSIGNMENT: 201 202 ARRX12 := ARRX11 ; 203 FAILED( "EXCEPTION NOT RAISED - SUBTEST 11" ); 204 205 EXCEPTION 206 207 WHEN CONSTRAINT_ERROR => 208 209 NULL ; 210 211 WHEN OTHERS => 212 213 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 11" ); 214 215 END ; 216 217 218 ------------------------------------------------------------------- 219 220 -- (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS 221 -- WERE DEFINED USING THE "BOX" SYMBOL 222 -- AND FOR WHICH THE COMPONENT TYPE IS NOT 'CHARACTER' . 223 -- ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.) 224 225 DECLARE 226 227 TYPE TABOX5 IS ARRAY( INTEGER RANGE <> ) OF BOOLEAN ; 228 229 SUBTYPE TABOX51 IS TABOX5( IDENT_INT(1)..IDENT_INT(5) ); 230 231 ARRX51 : TABOX51 ; 232 ARRX52 : TABOX5( IDENT_INT(5)..IDENT_INT(9) ); 233 234 BEGIN 235 236 -- INITIALIZATION OF RHS ARRAY: 237 238 FOR I IN IDENT_INT(1)..IDENT_INT(5) LOOP 239 ARRX51( I ) := FALSE ; -- VALUES WILL BE: F T F F T 240 END LOOP; 241 242 ARRX51(2) := TRUE ; 243 244 ARRX51(5) := TRUE ; -- RHS VALUES ARE: F T F F T 245 246 247 -- INITIALIZATION OF LHS ARRAY: 248 249 FOR I IN IDENT_INT(5)..IDENT_INT(9) LOOP 250 ARRX52( I ) := TRUE ; -- VALUES WILL BE: T F T T F 251 END LOOP; 252 253 ARRX52(6) := FALSE ; 254 255 ARRX52(9) := FALSE ; -- LHS VALUES ARE: T F T T F 256 257 258 -- NULL SLICE ASSIGNMENT: 259 260 ARRX52( IDENT_INT(6)..IDENT_INT(5) ) := 261 ARRX51 262 ( IDENT_INT(4)..IDENT_INT(4) ) ; 263 FAILED( "EXCEPTION NOT RAISED - SUBTEST 12" ); 264 265 EXCEPTION 266 267 WHEN CONSTRAINT_ERROR => 268 269 -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT: 270 IF ARRX52( 5 ) /= TRUE OR 271 ARRX52( 6 ) /= FALSE OR 272 ARRX52( 7 ) /= TRUE OR 273 ARRX52( 8 ) /= TRUE OR 274 ARRX52( 9 ) /= FALSE 275 THEN 276 FAILED( "LHS ARRAY ALTERED (12)" ); 277 END IF; 278 279 WHEN OTHERS => 280 281 FAILED( "WRONG EXCEPTION RAISED - SUBTEST 12" ); 282 283 END ; 284 285 286 ------------------------------------------------------------------- 287 288 289 RESULT ; 290 291 292END C52104P; 293