| -- CC1311A.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- CHECK THAT THE DEFAULT EXPRESSIONS OF THE PARAMETERS OF A FORMAL |
| -- SUBPROGRAM ARE USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE |
| -- ACTUAL SUBPROGRAM PARAMETER. |
| |
| -- HISTORY: |
| -- RJW 06/05/86 CREATED ORIGINAL TEST. |
| -- VCL 08/18/87 CHANGED A COUPLE OF STATIC DEFAULT EXPRESSIONS FOR |
| -- FORMAL SUBPROGRAM PARAMETERS TO DYNAMIC |
| -- EXPRESSIONS VIA THE USE OF THE IDENTITY FUNCTION. |
| -- EDWARD V. BERARD 08/13/90 |
| -- ADDED CHECKS FOR MULTI-DIMENSIONAL ARRAYS. |
| |
| WITH REPORT ; |
| |
| PROCEDURE CC1311A IS |
| |
| TYPE NUMBERS IS (ZERO, ONE ,TWO); |
| |
| SHORT_START : CONSTANT := -100 ; |
| SHORT_END : CONSTANT := 100 ; |
| TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ; |
| |
| SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ; |
| |
| TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, |
| SEP, OCT, NOV, DEC) ; |
| |
| SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ; |
| |
| TYPE DAY_TYPE IS RANGE 1 .. 31 ; |
| TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; |
| TYPE DATE IS RECORD |
| MONTH : MONTH_TYPE ; |
| DAY : DAY_TYPE ; |
| YEAR : YEAR_TYPE ; |
| END RECORD ; |
| |
| TODAY : DATE := (MONTH => AUG, |
| DAY => 8, |
| YEAR => 1990) ; |
| |
| FIRST_DATE : DATE := (DAY => 6, |
| MONTH => JUN, |
| YEAR => 1967) ; |
| |
| SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ; |
| |
| TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT, |
| FIRST_HALF, |
| FIRST_FIVE) OF DATE ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE)))) |
| RETURN CUBE ; |
| |
| PROCEDURE PROC_WITH_3D_FUNC ; |
| |
| PROCEDURE PROC_WITH_3D_FUNC IS |
| |
| BEGIN -- PROC_WITH_3D_FUNC |
| |
| IF FUN /= CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & |
| "ARRAY, FUNCTION, AND PROCEDURE.") ; |
| END IF ; |
| |
| END PROC_WITH_3D_FUNC ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE)))) |
| RETURN CUBE ; |
| |
| PACKAGE PKG_WITH_3D_FUNC IS |
| END PKG_WITH_3D_FUNC ; |
| |
| PACKAGE BODY PKG_WITH_3D_FUNC IS |
| BEGIN -- PKG_WITH_3D_FUNC |
| |
| REPORT.TEST("CC1311A","CHECK THAT THE DEFAULT EXPRESSIONS " & |
| "OF THE PARAMETERS OF A FORMAL SUBPROGRAM ARE " & |
| "USED INSTEAD OF THE DEFAULTS (IF ANY) OF THE " & |
| "ACTUAL SUBPROGRAM PARAMETER" ) ; |
| |
| IF FUN /= CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & |
| "ARRAY, FUNCTION, AND PACKAGE.") ; |
| END IF ; |
| |
| END PKG_WITH_3D_FUNC ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH FUNCTION FUN (FIRST : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE)))) |
| RETURN CUBE ; |
| |
| FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN ; |
| |
| FUNCTION FUNC_WITH_3D_FUNC RETURN BOOLEAN IS |
| BEGIN -- FUNC_WITH_3D_FUNC |
| |
| RETURN FUN = CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) ; |
| |
| END FUNC_WITH_3D_FUNC ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE))) ; |
| OUTPUT : OUT CUBE) ; |
| |
| PROCEDURE PROC_WITH_3D_PROC ; |
| |
| PROCEDURE PROC_WITH_3D_PROC IS |
| |
| RESULTS : CUBE ; |
| |
| BEGIN -- PROC_WITH_3D_PROC |
| |
| PROC (OUTPUT => RESULTS) ; |
| |
| IF RESULTS /= CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & |
| "ARRAY, PROCEDURE, AND PROCEDURE.") ; |
| END IF ; |
| |
| END PROC_WITH_3D_PROC ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE))) ; |
| OUTPUT : OUT CUBE) ; |
| |
| PACKAGE PKG_WITH_3D_PROC IS |
| END PKG_WITH_3D_PROC ; |
| |
| PACKAGE BODY PKG_WITH_3D_PROC IS |
| |
| RESULTS : CUBE ; |
| |
| BEGIN -- PKG_WITH_3D_PROC |
| |
| PROC (OUTPUT => RESULTS) ; |
| |
| IF RESULTS /= CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL " & |
| "ARRAY, PROCEDURE, AND PACKAGE.") ; |
| END IF ; |
| |
| END PKG_WITH_3D_PROC ; |
| |
| GENERIC |
| |
| TYPE FIRST_INDEX IS (<>) ; |
| TYPE SECOND_INDEX IS (<>) ; |
| TYPE THIRD_INDEX IS (<>) ; |
| TYPE COMPONENT_TYPE IS PRIVATE ; |
| DEFAULT_VALUE : IN COMPONENT_TYPE ; |
| TYPE CUBE IS ARRAY (FIRST_INDEX, |
| SECOND_INDEX, |
| THIRD_INDEX) OF COMPONENT_TYPE ; |
| WITH PROCEDURE PROC (INPUT : IN CUBE := (CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => |
| DEFAULT_VALUE))) ; |
| OUTPUT : OUT CUBE) ; |
| |
| FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN ; |
| |
| FUNCTION FUNC_WITH_3D_PROC RETURN BOOLEAN IS |
| |
| RESULTS : CUBE ; |
| |
| BEGIN -- FUNC_WITH_3D_PROC |
| |
| PROC (OUTPUT => RESULTS) ; |
| RETURN RESULTS = CUBE'(CUBE'RANGE => |
| (CUBE'RANGE (2) => |
| (CUBE'RANGE (3) => DEFAULT_VALUE))) ; |
| |
| END FUNC_WITH_3D_PROC ; |
| |
| GENERIC |
| TYPE T IS (<>); |
| WITH FUNCTION F (X : T := T'VAL (0)) RETURN T; |
| FUNCTION FUNC1 RETURN BOOLEAN; |
| |
| FUNCTION FUNC1 RETURN BOOLEAN IS |
| BEGIN -- FUNC1 |
| RETURN F = T'VAL (0); |
| END FUNC1; |
| |
| GENERIC |
| TYPE T IS (<>); |
| WITH FUNCTION F (X : T := T'VAL (REPORT.IDENT_INT(0))) |
| RETURN T; |
| PACKAGE PKG1 IS END PKG1; |
| |
| PACKAGE BODY PKG1 IS |
| BEGIN -- PKG1 |
| IF F /= T'VAL (0) THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & |
| "FUNCTION 'F' AND PACKAGE 'PKG1'" ); |
| END IF; |
| END PKG1; |
| GENERIC |
| TYPE T IS (<>); |
| WITH FUNCTION F (X : T := T'VAL (0)) RETURN T; |
| PROCEDURE PROC1; |
| |
| PROCEDURE PROC1 IS |
| BEGIN -- PROC1 |
| IF F /= T'VAL (0) THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & |
| "FUNCTION 'F' AND PROCEDURE 'PROC1'" ); |
| END IF; |
| END PROC1; |
| |
| GENERIC |
| TYPE T IS (<>); |
| WITH PROCEDURE P (RESULTS : OUT T ; |
| X : T := T'VAL (0)) ; |
| FUNCTION FUNC2 RETURN BOOLEAN; |
| |
| FUNCTION FUNC2 RETURN BOOLEAN IS |
| RESULTS : T; |
| BEGIN -- FUNC2 |
| P (RESULTS); |
| RETURN RESULTS = T'VAL (0); |
| END FUNC2; |
| |
| GENERIC |
| TYPE T IS (<>); |
| WITH PROCEDURE P (RESULTS : OUT T; |
| X : T := T'VAL(REPORT.IDENT_INT(0))); |
| PACKAGE PKG2 IS END PKG2 ; |
| |
| PACKAGE BODY PKG2 IS |
| RESULTS : T; |
| BEGIN -- PKG2 |
| P (RESULTS); |
| IF RESULTS /= T'VAL (0) THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & |
| "PROCEDURE 'P' AND PACKAGE 'PKG2'" ); |
| END IF; |
| END PKG2; |
| |
| GENERIC |
| TYPE T IS (<>); |
| WITH PROCEDURE P (RESULTS :OUT T; X : T := T'VAL (0)); |
| PROCEDURE PROC2; |
| |
| PROCEDURE PROC2 IS |
| RESULTS : T; |
| BEGIN -- PROC2 |
| P (RESULTS); |
| IF RESULTS /= T'VAL (0) THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE WITH " & |
| "PROCEDURE 'P' AND PROCEDURE 'PROC2'" ); |
| END IF; |
| END PROC2; |
| |
| FUNCTION F1 (A : NUMBERS := ONE) RETURN NUMBERS IS |
| BEGIN -- F1 |
| RETURN A; |
| END; |
| |
| PROCEDURE P2 (OUTVAR : OUT NUMBERS; INVAR : NUMBERS := TWO) IS |
| BEGIN -- P2 |
| OUTVAR := INVAR; |
| END; |
| |
| FUNCTION TD_FUNC (FIRST : IN THREE_DIMENSIONAL := |
| (THREE_DIMENSIONAL'RANGE => |
| (THREE_DIMENSIONAL'RANGE (2) => |
| (THREE_DIMENSIONAL'RANGE (3) => |
| FIRST_DATE)))) |
| RETURN THREE_DIMENSIONAL IS |
| |
| BEGIN -- TD_FUNC |
| |
| RETURN FIRST ; |
| |
| END TD_FUNC ; |
| |
| PROCEDURE TD_PROC (INPUT : IN THREE_DIMENSIONAL := |
| (THREE_DIMENSIONAL'RANGE => |
| (THREE_DIMENSIONAL'RANGE (2) => |
| (THREE_DIMENSIONAL'RANGE (3) => |
| FIRST_DATE))) ; |
| OUTPUT : OUT THREE_DIMENSIONAL) IS |
| BEGIN -- TD_PROC |
| |
| OUTPUT := INPUT ; |
| |
| END TD_PROC ; |
| |
| PROCEDURE NEW_PROC_WITH_3D_FUNC IS NEW |
| PROC_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| FUN => TD_FUNC) ; |
| |
| PACKAGE NEW_PKG_WITH_3D_FUNC IS NEW |
| PKG_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| FUN => TD_FUNC) ; |
| |
| FUNCTION NEW_FUNC_WITH_3D_FUNC IS NEW |
| FUNC_WITH_3D_FUNC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| FUN => TD_FUNC) ; |
| |
| PROCEDURE NEW_PROC_WITH_3D_PROC IS NEW |
| PROC_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| PROC => TD_PROC) ; |
| |
| PACKAGE NEW_PKG_WITH_3D_PROC IS NEW |
| PKG_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| PROC => TD_PROC) ; |
| |
| FUNCTION NEW_FUNC_WITH_3D_PROC IS NEW |
| FUNC_WITH_3D_PROC (FIRST_INDEX => REALLY_SHORT, |
| SECOND_INDEX => FIRST_HALF, |
| THIRD_INDEX => FIRST_FIVE, |
| COMPONENT_TYPE => DATE, |
| DEFAULT_VALUE => TODAY, |
| CUBE => THREE_DIMENSIONAL, |
| PROC => TD_PROC) ; |
| |
| FUNCTION NFUNC1 IS NEW FUNC1 (NUMBERS, F1); |
| PACKAGE NPKG1 IS NEW PKG1 (NUMBERS, F1); |
| PROCEDURE NPROC1 IS NEW PROC1 (NUMBERS, F1); |
| |
| FUNCTION NFUNC2 IS NEW FUNC2 (NUMBERS, P2); |
| PACKAGE NPKG2 IS NEW PKG2 (NUMBERS, P2); |
| PROCEDURE NPROC2 IS NEW PROC2 (NUMBERS, P2); |
| |
| BEGIN -- CC1311A |
| |
| IF NOT NFUNC1 THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE " & |
| "WITH FUNCTION 'NFUNC1'" ) ; |
| END IF ; |
| |
| IF NOT NFUNC2 THEN |
| REPORT.FAILED ("INCORRECT DEFAULT VALUE " & |
| "WITH FUNCTION 'NFUNC2'" ) ; |
| END IF ; |
| |
| NPROC1 ; |
| NPROC2 ; |
| |
| NEW_PROC_WITH_3D_FUNC ; |
| |
| IF NOT NEW_FUNC_WITH_3D_FUNC THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " & |
| "FUNCTION, AND FUNCTION.") ; |
| END IF ; |
| |
| NEW_PROC_WITH_3D_PROC ; |
| |
| IF NOT NEW_FUNC_WITH_3D_PROC THEN |
| REPORT.FAILED ("PROBLEMS WITH THREE DIMENSIONAL ARRAY, " & |
| "FUNCTION, AND PROCEDURE.") ; |
| END IF ; |
| |
| REPORT.RESULT ; |
| |
| END CC1311A ; |
