1-- C41203B.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 THE NAME PART OF A SLICE MAY BE: 27-- AN IDENTIFIER DENOTING A ONE DIMENSIONAL ARRAY OBJECT - N1; 28-- AN IDENTIFIER DENOTING AN ACCESS OBJECT WHOSE VALUE 29-- DESIGNATES A ONE DIMENSIONAL ARRAY OBJECT - N2; 30-- A FUNCTION CALL DELIVERING A ONE DIMENSIONAL ARRAY OBJECT 31-- USING PREDEFINED FUNCTIONS - &, AND THE LOGICAL OPERATORS 32-- A USER-DEFINED FUNCTION - F1; 33-- A FUNCTION CALL DELIVERING AN ACCESS VALUE THAT 34-- DESIGNATES A ONE DIMENSIONAL ARRAY - F2; 35-- A SLICE - N3; 36-- AN INDEXED COMPONENT DENOTING A ONE DIMENSIONAL ARRAY OBJECT 37-- (ARRAY OF ARRAYS) - N4; 38-- AN IDENTIFIER PREFIXED BY THE NAME OF THE INNERMOST UNIT 39-- ENCLOSING ITS DECLARATION - C41203B.N1; 40-- A RECORD COMPONENT (OF A RECORD CONTAINING ONE OR MORE 41-- ARRAYS WHOSE BOUNDS DEPEND ON A DISCRIMINANT) - N5. 42-- CHECK THAT THE APPROPRIATE SLICE IS ACCESSED (FOR 43-- DYNAMIC INDICES). 44 45-- HISTORY: 46-- WKB 08/05/81 CREATED ORIGINAL TEST. 47-- SPS 02/04/83 48-- BCB 08/02/88 MODIFIED HEADER FORMAT AND ADDED CALLS TO THE 49-- LOGICAL OPERATORS. 50-- BCB 04/16/90 ADDED TEST FOR PREFIX OF INDEXED COMPONENT HAVING 51-- A LIMITED TYPE. 52-- PWN 11/30/94 SUBTYPE QUALIFIED LITERALS FOR ADA 9X. 53 54WITH REPORT; 55USE REPORT; 56PROCEDURE C41203B IS 57 58 TYPE T1 IS ARRAY (INTEGER RANGE <> ) OF INTEGER; 59 SUBTYPE A1 IS T1 (1..6); 60 N1 : A1 := (1,2,3,4,5,6); 61 62BEGIN 63 TEST ("C41203B", "CHECK THAT THE NAME PART OF A SLICE MAY BE " & 64 "OF CERTAIN FORMS AND THAT THE APPROPRIATE " & 65 "SLICE IS ACCESSED (FOR DYNAMIC INDICES)"); 66 67 DECLARE 68 69 TYPE T2 IS ARRAY (INTEGER RANGE <> ) OF BOOLEAN; 70 SUBTYPE A2 IS T2 (1..6); 71 TYPE A3 IS ACCESS A1; 72 TYPE A4 IS ARRAY (INTEGER RANGE 1..3 ) OF A1; 73 TYPE R (LENGTH : INTEGER) IS 74 RECORD 75 S : STRING (1..LENGTH); 76 END RECORD; 77 78 N2 : A3 := NEW A1'(1,2,3,4,5,6); 79 N3 : T1(1..7) := (1,2,3,4,5,6,7); 80 N4 : A4 := (1 => (1,2,3,4,5,6), 2 => (7,8,9,10,11,12), 81 3 => (13,14,15,16,17,18)); 82 N5 : R(6) := (LENGTH => 6, S => "ABCDEF"); 83 84 M2A : A2 := (TRUE,TRUE,TRUE,FALSE,FALSE,FALSE); 85 M2B : A2 := (TRUE,FALSE,TRUE,FALSE,TRUE,FALSE); 86 87 FUNCTION F1 RETURN A2 IS 88 BEGIN 89 RETURN (FALSE,FALSE,TRUE,FALSE,TRUE,TRUE); 90 END F1; 91 92 FUNCTION F2 RETURN A3 IS 93 BEGIN 94 RETURN N2; 95 END F2; 96 97 PROCEDURE P1 (X : IN T1; Y : IN OUT T1; 98 Z : OUT T1; W : IN STRING) IS 99 BEGIN 100 IF X /= (1,2) THEN 101 FAILED ("WRONG VALUE FOR IN PARAMETER - " & W); 102 END IF; 103 IF Y /= (3,4) THEN 104 FAILED ("WRONG VALUE FOR IN OUT PARAMETER - " & W); 105 END IF; 106 Y := (10,11); 107 Z := (12,13); 108 END P1; 109 110 PROCEDURE P2 (X : STRING) IS 111 BEGIN 112 IF X /= "BC" THEN 113 FAILED ("WRONG VALUE FOR IN PARAMETER - '&'"); 114 END IF; 115 END P2; 116 117 PROCEDURE P3 (X : T2) IS 118 BEGIN 119 IF X /= (FALSE,TRUE,FALSE) THEN 120 FAILED ("WRONG VALUE FOR IN PARAMETER - F1"); 121 END IF; 122 END P3; 123 124 PROCEDURE P5 (X : IN STRING; Y : IN OUT STRING; 125 Z : OUT STRING) IS 126 BEGIN 127 IF X /= "EF" THEN 128 FAILED ("WRONG VALUE FOR IN PARAMETER - N5"); 129 END IF; 130 IF Y /= "CD" THEN 131 FAILED ("WRONG VALUE FOR IN OUT PARAMETER - N5"); 132 END IF; 133 Y := "XY"; 134 Z := "WZ"; 135 END P5; 136 137 PROCEDURE P6 (X : T2) IS 138 BEGIN 139 IF X /= (FALSE,FALSE,TRUE) THEN 140 FAILED ("WRONG VALUE FOR IN PARAMETER - NOT"); 141 END IF; 142 END P6; 143 144 PROCEDURE P7 (X : T2) IS 145 BEGIN 146 IF X /= (FALSE,TRUE,FALSE) THEN 147 FAILED ("WRONG VALUE FOR IN PARAMETER - AND"); 148 END IF; 149 END P7; 150 151 PROCEDURE P8 (X : T2) IS 152 BEGIN 153 IF X /= (FALSE,TRUE,FALSE) THEN 154 FAILED ("WRONG VALUE FOR IN PARAMETER - OR"); 155 END IF; 156 END P8; 157 158 PROCEDURE P9 (X : T2) IS 159 BEGIN 160 IF X /= (FALSE,TRUE,FALSE) THEN 161 FAILED ("WRONG VALUE FOR IN PARAMETER - XOR"); 162 END IF; 163 END P9; 164 165 BEGIN 166 167 IF N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN 168 FAILED ("WRONG VALUE FOR EXPRESSION - N1"); 169 END IF; 170 N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8); 171 IF N1 /= (7,8,3,4,5,6) THEN 172 FAILED ("WRONG TARGET FOR ASSIGNMENT - N1"); 173 END IF; 174 N1 := (1,2,3,4,5,6); 175 P1 (N1(IDENT_INT(1)..IDENT_INT(2)), 176 N1(IDENT_INT(3)..IDENT_INT(4)), 177 N1(IDENT_INT(5)..IDENT_INT(6)), "N1"); 178 IF N1 /= (1,2,10,11,12,13) THEN 179 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N1"); 180 END IF; 181 182 IF N2(IDENT_INT(4)..IDENT_INT(6)) /= (4,5,6) THEN 183 FAILED ("WRONG VALUE FOR EXPRESSION - N2"); 184 END IF; 185 N2(IDENT_INT(4)..IDENT_INT(6)) := (7,8,9); 186 IF N2.ALL /= (1,2,3,7,8,9) THEN 187 FAILED ("WRONG TARGET FOR ASSIGNMENT - N2"); 188 END IF; 189 N2.ALL := (1,2,5,6,3,4); 190 P1 (N2(IDENT_INT(1)..IDENT_INT(2)), 191 N2(IDENT_INT(5)..IDENT_INT(6)), 192 N2(IDENT_INT(3)..IDENT_INT(4)), "N2"); 193 IF N2.ALL /= (1,2,12,13,10,11) THEN 194 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N2"); 195 END IF; 196 197 IF "&" (STRING'("AB"),STRING'("CDEF"))(IDENT_INT(4)..IDENT_INT(6)) 198 /= STRING'("DEF") THEN 199 FAILED ("WRONG VALUE FOR EXPRESSION - '&'"); 200 END IF; 201 P2 ("&" ("AB","CD")(IDENT_INT(2)..IDENT_INT(3))); 202 203 IF "NOT" (M2A)(IDENT_INT(3)..IDENT_INT(5)) /= 204 (FALSE,TRUE,TRUE) THEN 205 FAILED ("WRONG VALUE FOR EXPRESSION - 'NOT'"); 206 END IF; 207 P6 ("NOT" (M2A)(IDENT_INT(2)..IDENT_INT(4))); 208 209 IF "AND" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /= 210 (TRUE,FALSE,FALSE) THEN 211 FAILED ("WRONG VALUE FOR EXPRESSION - 'AND'"); 212 END IF; 213 P7 ("AND" (M2A,M2B)(IDENT_INT(2)..IDENT_INT(4))); 214 215 IF "OR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /= 216 (TRUE,FALSE,TRUE) THEN 217 FAILED ("WRONG VALUE FOR EXPRESSION - 'OR'"); 218 END IF; 219 P8 ("OR" (M2A,M2B)(IDENT_INT(4)..IDENT_INT(6))); 220 221 IF "XOR" (M2A,M2B)(IDENT_INT(3)..IDENT_INT(5)) /= 222 (FALSE,FALSE,TRUE) THEN 223 FAILED ("WRONG VALUE FOR EXPRESSION - 'XOR'"); 224 END IF; 225 P9 ("XOR" (M2A,M2B)(IDENT_INT(1)..IDENT_INT(3))); 226 227 IF F1(IDENT_INT(1)..IDENT_INT(2)) /= (FALSE,FALSE) THEN 228 FAILED ("WRONG VALUE FOR EXPRESSION - F1"); 229 END IF; 230 P3 (F1(IDENT_INT(2)..IDENT_INT(4))); 231 232 N2 := NEW A1'(1,2,3,4,5,6); 233 IF F2(IDENT_INT(2)..IDENT_INT(6)) /= (2,3,4,5,6) THEN 234 FAILED ("WRONG VALUE FOR EXPRESSION - F2"); 235 END IF; 236 F2(IDENT_INT(3)..IDENT_INT(3)) := (5 => 7); 237 IF N2.ALL /= (1,2,7,4,5,6) THEN 238 FAILED ("WRONG TARGET FOR ASSIGNMENT - F2"); 239 END IF; 240 N2.ALL := (5,6,1,2,3,4); 241 P1 (F2(IDENT_INT(3)..IDENT_INT(4)), 242 F2(IDENT_INT(5)..IDENT_INT(6)), 243 F2(IDENT_INT(1)..IDENT_INT(2)), "F2"); 244 IF N2.ALL /= (12,13,1,2,10,11) THEN 245 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - F2"); 246 END IF; 247 248 IF N3(2..7)(IDENT_INT(2)..IDENT_INT(4)) /= (2,3,4) THEN 249 FAILED ("WRONG VALUE FOR EXPRESSION - N3"); 250 END IF; 251 N3(2..7)(IDENT_INT(4)..IDENT_INT(5)) := (8,9); 252 IF N3 /= (1,2,3,8,9,6,7) THEN 253 FAILED ("WRONG TARGET FOR ASSIGNMENT - N3"); 254 END IF; 255 N3 := (5,3,4,1,2,6,7); 256 P1 (N3(2..7)(IDENT_INT(4)..IDENT_INT(5)), 257 N3(2..7)(IDENT_INT(2)..IDENT_INT(3)), 258 N3(2..7)(IDENT_INT(6)..IDENT_INT(7)), "N3"); 259 IF N3 /= (5,10,11,1,2,12,13) THEN 260 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N3"); 261 END IF; 262 263 IF N4(1)(IDENT_INT(3)..IDENT_INT(5)) /= (3,4,5) THEN 264 FAILED ("WRONG VALUE FOR EXPRESSION - N4"); 265 END IF; 266 N4(2)(IDENT_INT(1)..IDENT_INT(3)) := (21,22,23); 267 IF N4 /= ((1,2,3,4,5,6),(21,22,23,10,11,12), 268 (13,14,15,16,17,18)) THEN 269 FAILED ("WRONG TARGET FOR ASSIGNMENT - N4"); 270 END IF; 271 N4 := (1 => (18,19,20,21,22,23), 2 => (17,16,15,1,2,14), 272 3 => (7,3,4,5,6,8)); 273 P1 (N4(2)(IDENT_INT(4)..IDENT_INT(5)), 274 N4(3)(IDENT_INT(2)..IDENT_INT(3)), 275 N4(1)(IDENT_INT(5)..IDENT_INT(6)), "N4"); 276 IF N4 /= ((18,19,20,21,12,13),(17,16,15,1,2,14), 277 (7,10,11,5,6,8)) THEN 278 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N4"); 279 END IF; 280 281 N1 := (1,2,3,4,5,6); 282 IF C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) /= (1,2) THEN 283 FAILED ("WRONG VALUE FOR EXPRESSION - C41203B.N1"); 284 END IF; 285 C41203B.N1(IDENT_INT(1)..IDENT_INT(2)) := (7,8); 286 IF N1 /= (7,8,3,4,5,6) THEN 287 FAILED ("WRONG TARGET FOR ASSIGNMENT - C41203B.N1"); 288 END IF; 289 N1 := (1,2,3,4,5,6); 290 P1 (C41203B.N1(IDENT_INT(1)..IDENT_INT(2)), 291 C41203B.N1(IDENT_INT(3)..IDENT_INT(4)), 292 C41203B.N1(IDENT_INT(5)..IDENT_INT(6)), "C41203B.N1"); 293 IF N1 /= (1,2,10,11,12,13) THEN 294 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER " & 295 "- C41203B.N1"); 296 END IF; 297 298 IF N5.S(IDENT_INT(1)..IDENT_INT(5)) /= "ABCDE" THEN 299 FAILED ("WRONG VALUE FOR EXPRESSION - N5"); 300 END IF; 301 N5.S(IDENT_INT(4)..IDENT_INT(6)) := "PQR"; 302 IF N5.S /= "ABCPQR" THEN 303 FAILED ("WRONG TARGET FOR ASSIGNMENT - N5"); 304 END IF; 305 N5.S := "ABCDEF"; 306 P5 (N5.S(IDENT_INT(5)..IDENT_INT(6)), 307 N5.S(IDENT_INT(3)..IDENT_INT(4)), 308 N5.S(IDENT_INT(1)..IDENT_INT(2))); 309 IF N5.S /= "WZXYEF" THEN 310 FAILED ("WRONG TARGET FOR (IN) OUT PARAMETER - N5"); 311 END IF; 312 313 DECLARE 314 PACKAGE P IS 315 TYPE LIM IS LIMITED PRIVATE; 316 TYPE A IS ARRAY(INTEGER RANGE <>) OF LIM; 317 PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER); 318 PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM); 319 FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN; 320 PRIVATE 321 TYPE LIM IS ARRAY(1..3) OF INTEGER; 322 END P; 323 324 USE P; 325 326 H : A(1..5); 327 328 N6 : A(1..3); 329 330 PACKAGE BODY P IS 331 PROCEDURE INIT (V : OUT LIM; X,Y,Z : INTEGER) IS 332 BEGIN 333 V := (X,Y,Z); 334 END INIT; 335 336 PROCEDURE ASSIGN (ONE : OUT LIM; TWO : LIM) IS 337 BEGIN 338 ONE := TWO; 339 END ASSIGN; 340 341 FUNCTION "=" (ONE,TWO : A) RETURN BOOLEAN IS 342 BEGIN 343 IF ONE(1) = TWO(2) AND ONE(2) = TWO(3) AND 344 ONE(3) = TWO(4) THEN 345 RETURN TRUE; 346 ELSE 347 RETURN FALSE; 348 END IF; 349 END "="; 350 END P; 351 352 FUNCTION FR RETURN A IS 353 BEGIN 354 RETURN H; 355 END FR; 356 357 BEGIN 358 INIT (H(1),1,2,3); 359 INIT (H(2),4,5,6); 360 INIT (H(3),7,8,9); 361 INIT (H(4),10,11,12); 362 INIT (H(5),13,14,15); 363 INIT (N6(1),0,0,0); 364 INIT (N6(2),0,0,0); 365 INIT (N6(3),0,0,0); 366 367 ASSIGN (N6(1),H(2)); 368 ASSIGN (N6(2),H(3)); 369 ASSIGN (N6(3),H(4)); 370 371 IF N6 /= FR(2..4) THEN 372 FAILED ("WRONG VALUE FROM LIMITED COMPONENT TYPE"); 373 END IF; 374 END; 375 END; 376 377 RESULT; 378END C41203B; 379