1-- CC3007A.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 NAMES IN A GENERIC DECLARATIONS ARE STATICALLY BOUND. 26 27-- DAT 9/18/81 28-- SPS 2/7/83 29 30WITH REPORT; USE REPORT; 31 32PROCEDURE CC3007A IS 33BEGIN 34 TEST ("CC3007A", "NAMES IN GENERICS ARE STATICALLY BOUND"); 35 36 DECLARE 37 I : INTEGER := 1; 38 EX : EXCEPTION; 39 IA : INTEGER := I'SIZE; 40 41 FUNCTION F (X : INTEGER) RETURN INTEGER; 42 43 PACKAGE P IS 44 Q : INTEGER := 1; 45 END P; 46 47 GENERIC 48 J : IN OUT INTEGER; 49 WITH FUNCTION FP (X : INTEGER) RETURN INTEGER IS F; 50 PACKAGE GP IS 51 V1 : INTEGER := F(I); 52 V2 : INTEGER := FP(I); 53 END GP; 54 55 GENERIC 56 TYPE T IS RANGE <> ; 57 WITH FUNCTION F1 (X : INTEGER) RETURN INTEGER IS F; 58 INP : IN T := T (I'SIZE); 59 FUNCTION F1 (X : T) RETURN T; 60 61 FUNCTION F1 (X : T) RETURN T IS 62 BEGIN 63 IF INP /= T(IA) THEN 64 FAILED ("INCORRECT GENERIC BINDING 2"); 65 END IF; 66 I := I + 1; 67 RETURN 2 * T (F1 (F (INTEGER (X) + I + P.Q))); 68 END F1; 69 70 PACKAGE BODY GP IS 71 PACKAGE P IS 72 Q : INTEGER := I + 1; 73 END P; 74 I : INTEGER := 1000; 75 FUNCTION F IS NEW F1 (INTEGER); 76 FUNCTION F2 IS NEW F1 (INTEGER); 77 BEGIN 78 P.Q := F2 (J + P.Q + V1 + 2 * V2); 79 J := P.Q; 80 RAISE EX; 81 END GP; 82 83 FUNCTION F (X : INTEGER) RETURN INTEGER IS 84 BEGIN 85 I := I + 2; 86 RETURN X + I; 87 END; 88 BEGIN 89 DECLARE 90 I : INTEGER := 1000; 91 EX : EXCEPTION; 92 FUNCTION F IS NEW F1 (INTEGER); 93 V : INTEGER := F (3); 94 BEGIN 95 BEGIN 96 DECLARE 97 PACKAGE P IS NEW GP (V); 98 BEGIN 99 FAILED ("EX NOT RAISED"); 100 END; 101 EXCEPTION 102 WHEN EX => 103 FAILED ("WRONG EXCEPTION RAISED"); 104 WHEN OTHERS => 105 IF V /= 266 THEN 106 FAILED ("WRONG BINDING IN GENERICS"); 107 END IF; 108 RAISE; 109 END; 110 111 END; 112 EXCEPTION 113 WHEN EX => NULL; 114 WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2"); 115 END; 116 117 RESULT; 118END CC3007A; 119