1-- CC3123A.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 DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY 26-- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS. 27 28-- TBN 12/01/86 29 30WITH REPORT; USE REPORT; 31PROCEDURE CC3123A IS 32 33BEGIN 34 TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " & 35 "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " & 36 "NO ACTUAL PARAMETERS"); 37 DECLARE 38 TYPE ENUM IS (I, II, III); 39 OBJ_INT : INTEGER := 1; 40 OBJ_ENUM : ENUM := I; 41 42 GENERIC 43 GEN_INT : IN INTEGER := IDENT_INT(2); 44 GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE); 45 GEN_ENUM : IN ENUM := II; 46 PACKAGE P IS 47 PAC_INT : INTEGER := GEN_INT; 48 PAC_BOOL : BOOLEAN := GEN_BOOL; 49 PAC_ENUM : ENUM := GEN_ENUM; 50 END P; 51 52 PACKAGE P1 IS NEW P; 53 PACKAGE P2 IS 54 NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM); 55 PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE)); 56 BEGIN 57 IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN 58 FAILED ("DEFAULT VALUES WERE NOT EVALUATED"); 59 END IF; 60 IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN 61 FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " & 62 "- 1"); 63 END IF; 64 IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR 65 P3.PAC_ENUM /= II THEN 66 FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " & 67 "- 2"); 68 END IF; 69 END; 70 71 ------------------------------------------------------------------- 72 DECLARE 73 OBJ_INT1 : INTEGER := 3; 74 75 FUNCTION FUNC (X : INTEGER) RETURN INTEGER; 76 77 GENERIC 78 GEN_INT1 : IN INTEGER := FUNC (1); 79 GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1); 80 PROCEDURE PROC; 81 82 PROCEDURE PROC IS 83 PROC_INT1 : INTEGER := GEN_INT1; 84 PROC_INT2 : INTEGER := GEN_INT2; 85 BEGIN 86 IF PROC_INT1 /= 3 THEN 87 FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & 88 "CORRECTLY - 3"); 89 END IF; 90 IF PROC_INT2 /= 4 THEN 91 FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & 92 "CORRECTLY - 4"); 93 END IF; 94 END PROC; 95 96 FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS 97 BEGIN 98 IF X /= IDENT_INT(4) THEN 99 FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & 100 "CORRECTLY - 5"); 101 END IF; 102 RETURN IDENT_INT(X); 103 END FUNC; 104 105 PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1); 106 107 BEGIN 108 NEW_PROC; 109 END; 110 111 ------------------------------------------------------------------- 112 DECLARE 113 TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER; 114 TYPE REC IS 115 RECORD 116 ANS : BOOLEAN; 117 ARA : ARA_TYP; 118 END RECORD; 119 TYPE ARA_REC IS ARRAY (1 .. 5) OF REC; 120 121 FUNCTION F (X : INTEGER) RETURN INTEGER; 122 123 OBJ_REC : REC := (FALSE, (3, 4)); 124 OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4))); 125 126 GENERIC 127 GEN_OBJ1 : IN ARA_TYP := (F(1), 2); 128 GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1); 129 GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2))); 130 FUNCTION FUNC RETURN INTEGER; 131 132 FUNCTION FUNC RETURN INTEGER IS 133 BEGIN 134 RETURN IDENT_INT(1); 135 END FUNC; 136 137 FUNCTION F (X : INTEGER) RETURN INTEGER IS 138 BEGIN 139 FAILED ("DEFAULT VALUES WERE EVALUATED - 1"); 140 RETURN IDENT_INT(X); 141 END F; 142 143 FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA); 144 145 BEGIN 146 IF NOT EQUAL (NEW_FUNC, 1) THEN 147 FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1"); 148 END IF; 149 END; 150 151 ------------------------------------------------------------------- 152 DECLARE 153 SUBTYPE INT IS INTEGER RANGE 1 .. 5; 154 TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER; 155 TYPE COLOR IS (RED, WHITE); 156 TYPE CON_REC (D : INT) IS 157 RECORD 158 A : COLOR; 159 B : ARA_TYP; 160 END RECORD; 161 TYPE UNCON_OR_CON_REC (D : INT := 2) IS 162 RECORD 163 A : COLOR; 164 B : ARA_TYP; 165 END RECORD; 166 FUNCTION F (X : COLOR) RETURN COLOR; 167 168 OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4)); 169 OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4)); 170 OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4)); 171 172 GENERIC 173 GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2)); 174 GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2)); 175 GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON; 176 FUNCTION FUNC RETURN INTEGER; 177 178 FUNCTION FUNC RETURN INTEGER IS 179 BEGIN 180 RETURN IDENT_INT(1); 181 END FUNC; 182 183 FUNCTION F (X : COLOR) RETURN COLOR IS 184 BEGIN 185 FAILED ("DEFAULT VALUES WERE EVALUATED - 2"); 186 RETURN WHITE; 187 END F; 188 189 FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2); 190 191 BEGIN 192 IF NOT EQUAL (NEW_FUNC, 1) THEN 193 FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2"); 194 END IF; 195 END; 196 197 RESULT; 198END CC3123A; 199