1-- CC1311A.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 THE DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL 26-- SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE 27-- ACTUAL SUBPROGRAM PARAMETER. 28 29-- HISTORY: 30-- RJW 06/05/86 CREATED ORIGINAL TEST. 31-- VCL 08/18/87 CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR 32-- FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC 33-- EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION. 34-- EDWARD V. BERARD 08/13/90 35-- ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS. 36 37WITH REPORT ; 38 39PROCEDURE CC1311A IS 40 41 TYPE NUMBERS IS (ZERO, ONE ,TWO); 42 43 SHORT_START : CONSTANT := -100 ; 44 SHORT_END : CONSTANT := 100 ; 45 TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ; 46 47 SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ; 48 49 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, 50 SEP, OCT, NOV, DEC) ; 51 52 SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ; 53 54 TYPE DAY_TYPE IS RANGE 1 .. 31 ; 55 TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; 56 TYPE DATE IS RECORD 57 MONTH : MONTH_TYPE ; 58 DAY : DAY_TYPE ; 59 YEAR : YEAR_TYPE ; 60 END RECORD ; 61 62 TODAY : DATE := (MONTH => AUG, 63 DAY => 8, 64 YEAR => 1990) ; 65 66 FIRST_DATE : DATE := (DAY => 6, 67 MONTH => JUN, 68 YEAR => 1967) ; 69 70 SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ; 71 72 TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT, 73 FIRST_HALF, 74 FIRST_FIVE) OF DATE ; 75 76 GENERIC 77 78 TYPE FIRST_INDEX IS (<>) ; 79 TYPE SECOND_INDEX IS (<>) ; 80 TYPE THIRD_INDEX IS (<>) ; 81 TYPE COMPONENT_TYPE IS PRIVATE ; 82 DEFAULT_VALUE : IN COMPONENT_TYPE ; 83 TYPE CUBE IS ARRAY (FIRST_INDEX, 84 SECOND_INDEX, 85 THIRD_INDEX) OF COMPONENT_TYPE ; 86 WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => 87 (CUBE'RANGE (2) => 88 (CUBE'RANGE (3) => 89 DEFAULT_VALUE)))) 90 RETURN CUBE ; 91 92 PROCEDURE PROC_WITH_3D_FUNC ; 93 94 PROCEDURE PROC_WITH_3D_FUNC IS 95 96 BEGIN -- PROC_WITH_3D_FUNC 97 98 IF FUN /= CUBE'(CUBE'RANGE => 99 (CUBE'RANGE (2) => 100 (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN 101 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & 102 "ARRAY, FUNCTION, AND PROCEDURE.") ; 103 END IF ; 104 105 END PROC_WITH_3D_FUNC ; 106 107 GENERIC 108 109 TYPE FIRST_INDEX IS (<>) ; 110 TYPE SECOND_INDEX IS (<>) ; 111 TYPE THIRD_INDEX IS (<>) ; 112 TYPE COMPONENT_TYPE IS PRIVATE ; 113 DEFAULT_VALUE : IN COMPONENT_TYPE ; 114 TYPE CUBE IS ARRAY (FIRST_INDEX, 115 SECOND_INDEX, 116 THIRD_INDEX) OF COMPONENT_TYPE ; 117 WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => 118 (CUBE'RANGE (2) => 119 (CUBE'RANGE (3) => 120 DEFAULT_VALUE)))) 121 RETURN CUBE ; 122 123 PACKAGE PKG_WITH_3D_FUNC IS 124 END PKG_WITH_3D_FUNC ; 125 126 PACKAGE BODY PKG_WITH_3D_FUNC IS 127 BEGIN -- PKG_WITH_3D_FUNC 128 129 REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " & 130 "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " & 131 "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " & 132 "ACTUAL SUBPROGRAM PARAMETER" ) ; 133 134 IF FUN /= CUBE'(CUBE'RANGE => 135 (CUBE'RANGE (2) => 136 (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN 137 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & 138 "ARRAY, FUNCTION, AND PACKAGE.") ; 139 END IF ; 140 141 END PKG_WITH_3D_FUNC ; 142 143 GENERIC 144 145 TYPE FIRST_INDEX IS (<>) ; 146 TYPE SECOND_INDEX IS (<>) ; 147 TYPE THIRD_INDEX IS (<>) ; 148 TYPE COMPONENT_TYPE IS PRIVATE ; 149 DEFAULT_VALUE : IN COMPONENT_TYPE ; 150 TYPE CUBE IS ARRAY (FIRST_INDEX, 151 SECOND_INDEX, 152 THIRD_INDEX) OF COMPONENT_TYPE ; 153 WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => 154 (CUBE'RANGE (2) => 155 (CUBE'RANGE (3) => 156 DEFAULT_VALUE)))) 157 RETURN CUBE ; 158 159 FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ; 160 161 FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS 162 BEGIN -- FUNC_WITH_3D_FUNC 163 164 RETURN FUN = CUBE'(CUBE'RANGE => 165 (CUBE'RANGE (2) => 166 (CUBE'RANGE (3) => DEFAULT_VALUE))) ; 167 168 END FUNC_WITH_3D_FUNC ; 169 170 GENERIC 171 172 TYPE FIRST_INDEX IS (<>) ; 173 TYPE SECOND_INDEX IS (<>) ; 174 TYPE THIRD_INDEX IS (<>) ; 175 TYPE COMPONENT_TYPE IS PRIVATE ; 176 DEFAULT_VALUE : IN COMPONENT_TYPE ; 177 TYPE CUBE IS ARRAY (FIRST_INDEX, 178 SECOND_INDEX, 179 THIRD_INDEX) OF COMPONENT_TYPE ; 180 WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => 181 (CUBE'RANGE (2) => 182 (CUBE'RANGE (3) => 183 DEFAULT_VALUE))) ; 184 OUTPUT : OUT CUBE) ; 185 186 PROCEDURE PROC_WITH_3D_PROC ; 187 188 PROCEDURE PROC_WITH_3D_PROC IS 189 190 RESULTS : CUBE ; 191 192 BEGIN -- PROC_WITH_3D_PROC 193 194 PROC (OUTPUT => RESULTS) ; 195 196 IF RESULTS /= CUBE'(CUBE'RANGE => 197 (CUBE'RANGE (2) => 198 (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN 199 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & 200 "ARRAY, PROCEDURE, AND PROCEDURE.") ; 201 END IF ; 202 203 END PROC_WITH_3D_PROC ; 204 205 GENERIC 206 207 TYPE FIRST_INDEX IS (<>) ; 208 TYPE SECOND_INDEX IS (<>) ; 209 TYPE THIRD_INDEX IS (<>) ; 210 TYPE COMPONENT_TYPE IS PRIVATE ; 211 DEFAULT_VALUE : IN COMPONENT_TYPE ; 212 TYPE CUBE IS ARRAY (FIRST_INDEX, 213 SECOND_INDEX, 214 THIRD_INDEX) OF COMPONENT_TYPE ; 215 WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => 216 (CUBE'RANGE (2) => 217 (CUBE'RANGE (3) => 218 DEFAULT_VALUE))) ; 219 OUTPUT : OUT CUBE) ; 220 221 PACKAGE PKG_WITH_3D_PROC IS 222 END PKG_WITH_3D_PROC ; 223 224 PACKAGE BODY PKG_WITH_3D_PROC IS 225 226 RESULTS : CUBE ; 227 228 BEGIN -- PKG_WITH_3D_PROC 229 230 PROC (OUTPUT => RESULTS) ; 231 232 IF RESULTS /= CUBE'(CUBE'RANGE => 233 (CUBE'RANGE (2) => 234 (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN 235 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & 236 "ARRAY, PROCEDURE, AND PACKAGE.") ; 237 END IF ; 238 239 END PKG_WITH_3D_PROC ; 240 241 GENERIC 242 243 TYPE FIRST_INDEX IS (<>) ; 244 TYPE SECOND_INDEX IS (<>) ; 245 TYPE THIRD_INDEX IS (<>) ; 246 TYPE COMPONENT_TYPE IS PRIVATE ; 247 DEFAULT_VALUE : IN COMPONENT_TYPE ; 248 TYPE CUBE IS ARRAY (FIRST_INDEX, 249 SECOND_INDEX, 250 THIRD_INDEX) OF COMPONENT_TYPE ; 251 WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => 252 (CUBE'RANGE (2) => 253 (CUBE'RANGE (3) => 254 DEFAULT_VALUE))) ; 255 OUTPUT : OUT CUBE) ; 256 257 FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ; 258 259 FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS 260 261 RESULTS : CUBE ; 262 263 BEGIN -- FUNC_WITH_3D_PROC 264 265 PROC (OUTPUT => RESULTS) ; 266 RETURN RESULTS = CUBE'(CUBE'RANGE => 267 (CUBE'RANGE (2) => 268 (CUBE'RANGE (3) => DEFAULT_VALUE))) ; 269 270 END FUNC_WITH_3D_PROC ; 271 272 GENERIC 273 TYPE T IS (<>); 274 WITH FUNCTION F (X : T := T'VAL (0)) RETURN T; 275 FUNCTION FUNC1 RETURN BOOLEAN; 276 277 FUNCTION FUNC1 RETURN BOOLEAN IS 278 BEGIN -- FUNC1 279 RETURN F = T'VAL (0); 280 END FUNC1; 281 282 GENERIC 283 TYPE T IS (<>); 284 WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0))) 285 RETURN T; 286 PACKAGE PKG1 IS END PKG1; 287 288 PACKAGE BODY PKG1 IS 289 BEGIN -- PKG1 290 IF F /= T'VAL (0) THEN 291 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & 292 "FUNCTION 'F' AND PACKAGE 'PKG1'" ); 293 END IF; 294 END PKG1; 295 GENERIC 296 TYPE T IS (<>); 297 WITH FUNCTION F (X : T := T'VAL (0)) RETURN T; 298 PROCEDURE PROC1; 299 300 PROCEDURE PROC1 IS 301 BEGIN -- PROC1 302 IF F /= T'VAL (0) THEN 303 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & 304 "FUNCTION 'F' AND PROCEDURE 'PROC1'" ); 305 END IF; 306 END PROC1; 307 308 GENERIC 309 TYPE T IS (<>); 310 WITH PROCEDURE P (RESULTS : OUT T ; 311 X : T := T'VAL (0)) ; 312 FUNCTION FUNC2 RETURN BOOLEAN; 313 314 FUNCTION FUNC2 RETURN BOOLEAN IS 315 RESULTS : T; 316 BEGIN -- FUNC2 317 P (RESULTS); 318 RETURN RESULTS = T'VAL (0); 319 END FUNC2; 320 321 GENERIC 322 TYPE T IS (<>); 323 WITH PROCEDURE P (RESULTS : OUT T; 324 X : T := T'VAL(REPORT.IDENT_INT(0))); 325 PACKAGE PKG2 IS END PKG2 ; 326 327 PACKAGE BODY PKG2 IS 328 RESULTS : T; 329 BEGIN -- PKG2 330 P (RESULTS); 331 IF RESULTS /= T'VAL (0) THEN 332 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & 333 "PROCEDURE 'P' AND PACKAGE 'PKG2'" ); 334 END IF; 335 END PKG2; 336 337 GENERIC 338 TYPE T IS (<>); 339 WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0)); 340 PROCEDURE PROC2; 341 342 PROCEDURE PROC2 IS 343 RESULTS : T; 344 BEGIN -- PROC2 345 P (RESULTS); 346 IF RESULTS /= T'VAL (0) THEN 347 REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & 348 "PROCEDURE 'P' AND PROCEDURE 'PROC2'" ); 349 END IF; 350 END PROC2; 351 352 FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS 353 BEGIN -- F1 354 RETURN A; 355 END; 356 357 PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS 358 BEGIN -- P2 359 OUTVAR := INVAR; 360 END; 361 362 FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL := 363 (THREE_DIMENSIONAL'RANGE => 364 (THREE_DIMENSIONAL'RANGE (2) => 365 (THREE_DIMENSIONAL'RANGE (3) => 366 FIRST_DATE)))) 367 RETURN THREE_DIMENSIONAL IS 368 369 BEGIN -- TD_FUNC 370 371 RETURN FIRST ; 372 373 END TD_FUNC ; 374 375 PROCEDURE TD_PROC (INPUT : IN THREE_DIMENSIONAL := 376 (THREE_DIMENSIONAL'RANGE => 377 (THREE_DIMENSIONAL'RANGE (2) => 378 (THREE_DIMENSIONAL'RANGE (3) => 379 FIRST_DATE))) ; 380 OUTPUT : OUT THREE_DIMENSIONAL) IS 381 BEGIN -- TD_PROC 382 383 OUTPUT := INPUT ; 384 385 END TD_PROC ; 386 387 PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW 388 PROC_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, 389 SECOND_INDEX => FIRST_HALF, 390 THIRD_INDEX => FIRST_FIVE, 391 COMPONENT_TYPE => DATE, 392 DEFAULT_VALUE => TODAY, 393 CUBE => THREE_DIMENSIONAL, 394 FUN => TD_FUNC) ; 395 396 PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW 397 PKG_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, 398 SECOND_INDEX => FIRST_HALF, 399 THIRD_INDEX => FIRST_FIVE, 400 COMPONENT_TYPE => DATE, 401 DEFAULT_VALUE => TODAY, 402 CUBE => THREE_DIMENSIONAL, 403 FUN => TD_FUNC) ; 404 405 FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW 406 FUNC_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, 407 SECOND_INDEX => FIRST_HALF, 408 THIRD_INDEX => FIRST_FIVE, 409 COMPONENT_TYPE => DATE, 410 DEFAULT_VALUE => TODAY, 411 CUBE => THREE_DIMENSIONAL, 412 FUN => TD_FUNC) ; 413 414 PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW 415 PROC_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, 416 SECOND_INDEX => FIRST_HALF, 417 THIRD_INDEX => FIRST_FIVE, 418 COMPONENT_TYPE => DATE, 419 DEFAULT_VALUE => TODAY, 420 CUBE => THREE_DIMENSIONAL, 421 PROC => TD_PROC) ; 422 423 PACKAGE NEW_PKG_WITH_3D_PROC IS NEW 424 PKG_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, 425 SECOND_INDEX => FIRST_HALF, 426 THIRD_INDEX => FIRST_FIVE, 427 COMPONENT_TYPE => DATE, 428 DEFAULT_VALUE => TODAY, 429 CUBE => THREE_DIMENSIONAL, 430 PROC => TD_PROC) ; 431 432 FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW 433 FUNC_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, 434 SECOND_INDEX => FIRST_HALF, 435 THIRD_INDEX => FIRST_FIVE, 436 COMPONENT_TYPE => DATE, 437 DEFAULT_VALUE => TODAY, 438 CUBE => THREE_DIMENSIONAL, 439 PROC => TD_PROC) ; 440 441 FUNCTION NFUNC1 IS NEW FUNC1 (NUMBERS, F1); 442 PACKAGE NPKG1 IS NEW PKG1 (NUMBERS, F1); 443 PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1); 444 445 FUNCTION NFUNC2 IS NEW FUNC2 (NUMBERS, P2); 446 PACKAGE NPKG2 IS NEW PKG2 (NUMBERS, P2); 447 PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2); 448 449BEGIN -- CC1311A 450 451 IF NOT NFUNC1 THEN 452 REPORT.FAILED ("INCORRECT DEFAULT VALUE " & 453 "WITH FUNCTION 'NFUNC1'" ) ; 454 END IF ; 455 456 IF NOT NFUNC2 THEN 457 REPORT.FAILED ("INCORRECT DEFAULT VALUE " & 458 "WITH FUNCTION 'NFUNC2'" ) ; 459 END IF ; 460 461 NPROC1 ; 462 NPROC2 ; 463 464 NEW_PROC_WITH_3D_FUNC ; 465 466 IF NOT NEW_FUNC_WITH_3D_FUNC THEN 467 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " & 468 "FUNCTION, AND FUNCTION.") ; 469 END IF ; 470 471 NEW_PROC_WITH_3D_PROC ; 472 473 IF NOT NEW_FUNC_WITH_3D_PROC THEN 474 REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " & 475 "FUNCTION, AND PROCEDURE.") ; 476 END IF ; 477 478 REPORT.RESULT ; 479 480END CC1311A ; 481