1-- C83022A.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 A DECLARATION IN A SUBPROGRAM FORMAL PART OR BODY 27-- HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK THAT THE 28-- OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH DECLARATIVE 29-- REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH AND THE 30-- OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER 31-- HOMOGRAH DECLARATION. 32 33-- HISTORY: 34-- TBN 08/01/88 CREATED ORIGINAL TEST. 35 36WITH REPORT; USE REPORT; 37PROCEDURE C83022A IS 38 39 GENERIC 40 TYPE T IS PRIVATE; 41 X : T; 42 FUNCTION GEN_FUN RETURN T; 43 44 FUNCTION GEN_FUN RETURN T IS 45 BEGIN 46 RETURN X; 47 END GEN_FUN; 48 49BEGIN 50 TEST ("C83022A", "CHECK THAT A DECLARATION IN A SUBPROGRAM " & 51 "FORMAL PART OR BODY HIDES AN OUTER " & 52 "DECLARATION OF A HOMOGRAPH"); 53 54 ONE: 55 DECLARE -- SUBPROGRAM DECLARATIVE REGION. 56 A : INTEGER := IDENT_INT(2); 57 B : INTEGER := A; 58 59 PROCEDURE INNER (X : IN OUT INTEGER) IS 60 C : INTEGER := A; 61 A : INTEGER := IDENT_INT(3); 62 BEGIN 63 IF A /= IDENT_INT(3) THEN 64 FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1"); 65 END IF; 66 IF ONE.A /= IDENT_INT(2) THEN 67 FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2"); 68 END IF; 69 IF ONE.B /= IDENT_INT(2) THEN 70 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3"); 71 END IF; 72 IF C /= IDENT_INT(2) THEN 73 FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4"); 74 END IF; 75 IF X /= IDENT_INT(2) THEN 76 FAILED ("INCORRECT VALUE PASSED IN - 5"); 77 END IF; 78 IF EQUAL(1,1) THEN 79 X := A; 80 ELSE 81 X := ONE.A; 82 END IF; 83 END INNER; 84 85 BEGIN -- ONE 86 INNER (A); 87 IF A /= IDENT_INT(3) THEN 88 FAILED ("INCORRECT VALUE PASSED OUT - 6"); 89 END IF; 90 END ONE; 91 92 TWO: 93 DECLARE -- FORMAL PARAMETER OF SUBPROGRAM. 94 A : INTEGER := IDENT_INT(2); 95 B : INTEGER := A; 96 OBJ : INTEGER := IDENT_INT(3); 97 98 PROCEDURE INNER (X : IN INTEGER := A; 99 A : IN OUT INTEGER) IS 100 C : INTEGER := A; 101 BEGIN 102 IF A /= IDENT_INT(3) THEN 103 FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10"); 104 END IF; 105 IF TWO.A /= IDENT_INT(2) THEN 106 FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11"); 107 END IF; 108 IF TWO.B /= IDENT_INT(2) THEN 109 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12"); 110 END IF; 111 IF C /= IDENT_INT(3) THEN 112 FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13"); 113 END IF; 114 IF X /= IDENT_INT(2) THEN 115 FAILED ("INCORRECT VALUE PASSED IN - 14"); 116 END IF; 117 IF EQUAL(1,1) THEN 118 A := IDENT_INT(4); 119 ELSE 120 A := 1; 121 END IF; 122 END INNER; 123 124 BEGIN -- TWO 125 INNER (A => OBJ); 126 IF OBJ /= IDENT_INT(4) THEN 127 FAILED ("INCORRECT VALUE PASSED OUT - 15"); 128 END IF; 129 END TWO; 130 131 THREE: 132 DECLARE -- AFTER THE SPECIFICATION OF SUBPROGRAM. 133 A : INTEGER := IDENT_INT(2); 134 135 FUNCTION INNER (X : INTEGER) RETURN INTEGER; 136 137 B : INTEGER := A; 138 139 FUNCTION INNER (X : INTEGER) RETURN INTEGER IS 140 C : INTEGER := A; 141 A : INTEGER := IDENT_INT(3); 142 BEGIN 143 IF A /= IDENT_INT(3) THEN 144 FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20"); 145 END IF; 146 IF THREE.A /= IDENT_INT(2) THEN 147 FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21"); 148 END IF; 149 IF THREE.B /= IDENT_INT(2) THEN 150 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22"); 151 END IF; 152 IF C /= IDENT_INT(2) THEN 153 FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23"); 154 END IF; 155 IF X /= IDENT_INT(2) THEN 156 FAILED ("INCORRECT VALUE PASSED IN - 24"); 157 END IF; 158 IF EQUAL(1,1) THEN 159 RETURN A; 160 ELSE 161 RETURN X; 162 END IF; 163 END INNER; 164 165 BEGIN -- THREE 166 IF INNER(A) /= IDENT_INT(3) THEN 167 FAILED ("INCORRECT VALUE PASSED OUT - 25"); 168 END IF; 169 END THREE; 170 171 FOUR: 172 DECLARE -- RENAMING DECLARATION. 173 A : INTEGER := IDENT_INT(2); 174 175 PROCEDURE TEMPLATE (X : IN INTEGER := A; 176 Y : IN OUT INTEGER); 177 178 PROCEDURE INNER (Z : IN INTEGER := A; 179 A : IN OUT INTEGER) RENAMES TEMPLATE; 180 181 B : INTEGER := A; 182 OBJ : INTEGER := 5; 183 184 PROCEDURE TEMPLATE (X : IN INTEGER := A; 185 Y : IN OUT INTEGER) IS 186 BEGIN -- TEMPLATE 187 IF X /= IDENT_INT(2) THEN 188 FAILED ("INCORRECT RESULTS FOR VARIABLE - 30"); 189 END IF; 190 IF Y /= IDENT_INT(5) THEN 191 FAILED ("INCORRECT RESULTS FOR VARIABLE - 31"); 192 END IF; 193 Y := IDENT_INT(2 * X); 194 IF FOUR.A /= IDENT_INT(2) THEN 195 FAILED ("INCORRECT RESULTS FOR OUTER HOMOGRAPH - " & 196 "32"); 197 END IF; 198 END TEMPLATE; 199 200 BEGIN -- FOUR 201 IF B /= IDENT_INT(2) THEN 202 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 32"); 203 END IF; 204 INNER (A => OBJ); 205 IF OBJ /= IDENT_INT(4) THEN 206 FAILED ("INCORRECT VALUE PASSED OUT - 33"); 207 END IF; 208 END FOUR; 209 210 FIVE: 211 DECLARE -- GENERIC FORMAL SUBPROGRAM. 212 A : INTEGER := IDENT_INT(2); 213 B : INTEGER := A; 214 215 PROCEDURE INNER (X : IN OUT INTEGER); 216 217 GENERIC 218 WITH PROCEDURE SUBPR (Y : IN OUT INTEGER) IS <>; 219 PACKAGE P IS 220 PAC_VAR : INTEGER := 1; 221 END P; 222 223 PROCEDURE INNER (X : IN OUT INTEGER) IS 224 C : INTEGER := A; 225 A : INTEGER := IDENT_INT(3); 226 BEGIN 227 IF A /= IDENT_INT(3) THEN 228 FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 41"); 229 END IF; 230 IF FIVE.A /= IDENT_INT(2) THEN 231 FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 42"); 232 END IF; 233 IF FIVE.B /= IDENT_INT(2) THEN 234 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 43"); 235 END IF; 236 IF C /= IDENT_INT(2) THEN 237 FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 44"); 238 END IF; 239 IF X /= IDENT_INT(2) THEN 240 FAILED ("INCORRECT VALUE PASSED IN - 45"); 241 END IF; 242 IF EQUAL(1,1) THEN 243 X := A; 244 ELSE 245 X := FIVE.A; 246 END IF; 247 END INNER; 248 249 PACKAGE BODY P IS 250 BEGIN 251 SUBPR (A); 252 IF A /= IDENT_INT(3) THEN 253 FAILED ("INCORRECT VALUE PASSED OUT - 46"); 254 END IF; 255 IF PAC_VAR /= IDENT_INT(1) THEN 256 FAILED ("INCORRECT VALUE FOR PAC_VAR - 47"); 257 END IF; 258 END P; 259 260 PACKAGE NEW_P IS NEW P (INNER); 261 262 BEGIN -- FIVE 263 NULL; 264 END FIVE; 265 266 SIX: 267 DECLARE -- GENERIC INSTANTIATION. 268 A : INTEGER := IDENT_INT(2); 269 B : INTEGER := A; 270 OBJ : INTEGER := IDENT_INT(3); 271 272 GENERIC 273 PROCEDURE INNER (X : IN INTEGER := A; 274 A : IN OUT INTEGER); 275 276 PROCEDURE INNER (X : IN INTEGER := SIX.A; 277 A : IN OUT INTEGER) IS 278 C : INTEGER := A; 279 BEGIN 280 IF A /= IDENT_INT(3) THEN 281 FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -50"); 282 END IF; 283 IF SIX.A /= IDENT_INT(2) THEN 284 FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 51"); 285 END IF; 286 IF SIX.B /= IDENT_INT(2) THEN 287 FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 52"); 288 END IF; 289 IF C /= IDENT_INT(3) THEN 290 FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 53"); 291 END IF; 292 IF X /= IDENT_INT(2) THEN 293 FAILED ("INCORRECT VALUE PASSED IN - 54"); 294 END IF; 295 IF EQUAL(1,1) THEN 296 A := IDENT_INT(4); 297 ELSE 298 A := 1; 299 END IF; 300 END INNER; 301 302 PROCEDURE SUBPR IS NEW INNER; 303 304 BEGIN -- SIX 305 SUBPR (A => OBJ); 306 IF OBJ /= IDENT_INT(4) THEN 307 FAILED ("INCORRECT VALUE PASSED OUT - 55"); 308 END IF; 309 END SIX; 310 311 SEVEN: 312 DECLARE -- OVERLOADING OF FUNCTIONS. 313 314 OBJ : INTEGER := 1; 315 FLO : FLOAT := 5.0; 316 317 FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ); 318 319 PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT); 320 321 FUNCTION F IS NEW GEN_FUN (FLOAT, FLO); 322 323 PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS 324 BEGIN 325 X := INTEGER(F); 326 END INNER; 327 328 BEGIN 329 FLO := 6.25; 330 INNER (OBJ, FLO); 331 IF OBJ /= IDENT_INT(6) THEN 332 FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60"); 333 END IF; 334 END SEVEN; 335 336 337 RESULT; 338END C83022A; 339