1-- C39006B.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 PROGRAM_ERROR IS RAISED IF AN ATTEMPT IS MADE TO CALL A 26-- SUBPROGRAM WHOSE BODY HAS NOT YET BEEN ELABORATED. CHECK THE 27-- FOLLOWING: 28-- B) THE SUBPROGRAM IS CALLED IN A PACKAGE BODY. 29-- C) THE SUBPROGRAM IS AN ACTUAL GENERIC PARAMETER CALLED DURING 30-- ELABORATION OF THE GENERIC INSTANTIATION. 31-- D) THE SUBPROGRAM IS CALLED DURING ELABORATION OF AN OPTIONAL 32-- PACKAGE BODY. 33 34-- TBN 8/19/86 35 36WITH REPORT; USE REPORT; 37PROCEDURE C39006B IS 38 39BEGIN 40 TEST ("C39006B", "CHECK THAT PROGRAM_ERROR IS RAISED IF AN " & 41 "ATTEMPT IS MADE TO CALL A SUBPROGRAM WHOSE " & 42 "BODY HAS NOT YET BEEN ELABORATED"); 43 BEGIN 44 DECLARE 45 PACKAGE PACK IS 46 FUNCTION FUN RETURN INTEGER; 47 PROCEDURE PROC (A : IN OUT INTEGER); 48 END PACK; 49 50 PACKAGE BODY PACK IS 51 52 VAR1 : INTEGER := 0; 53 54 PROCEDURE PROC (A : IN OUT INTEGER) IS 55 BEGIN 56 IF A = IDENT_INT(1) THEN 57 A := A + FUN; 58 FAILED ("PROGRAM_ERROR NOT RAISED - 1"); 59 ELSE 60 A := IDENT_INT(1); 61 END IF; 62 EXCEPTION 63 WHEN PROGRAM_ERROR => 64 NULL; 65 WHEN OTHERS => 66 FAILED ("UNEXPECTED EXCEPTION RAISED " & 67 "1"); 68 END PROC; 69 70 PACKAGE INSIDE IS 71 END INSIDE; 72 73 PACKAGE BODY INSIDE IS 74 BEGIN 75 PROC (VAR1); 76 PROC (VAR1); 77 END INSIDE; 78 79 FUNCTION FUN RETURN INTEGER IS 80 BEGIN 81 RETURN (IDENT_INT(1)); 82 END FUN; 83 84 BEGIN 85 NULL; 86 END PACK; 87 88 BEGIN 89 NULL; 90 END; 91 END; 92 93 BEGIN 94 DECLARE 95 FUNCTION INIT_2 RETURN INTEGER; 96 97 GENERIC 98 WITH FUNCTION FF RETURN INTEGER; 99 PACKAGE P IS 100 Y : INTEGER; 101 END P; 102 103 GLOBAL_INT : INTEGER := IDENT_INT(1); 104 105 PACKAGE BODY P IS 106 BEGIN 107 IF GLOBAL_INT = 1 THEN 108 Y := FF; 109 END IF; 110 END P; 111 112 PACKAGE N IS 113 PACKAGE NEW_P IS NEW P(INIT_2); 114 END N; 115 116 FUNCTION INIT_2 RETURN INTEGER IS 117 BEGIN 118 RETURN (IDENT_INT (1)); 119 END INIT_2; 120 121 BEGIN 122 FAILED ("PROGRAM_ERROR NOT RAISED - 2"); 123 END; 124 125 EXCEPTION 126 WHEN PROGRAM_ERROR => 127 NULL; 128 WHEN OTHERS => 129 FAILED ("UNEXPECTED EXCEPTION RAISED - 2"); 130 END; 131 132 DECLARE 133 134 PROCEDURE ADD1 (A : IN OUT INTEGER); 135 136 PACKAGE P IS 137 VAR : INTEGER := IDENT_INT(1); 138 END P; 139 140 PACKAGE BODY P IS 141 BEGIN 142 IF VAR = 1 THEN 143 ADD1 (VAR); 144 FAILED ("PROGRAM_ERROR NOT RAISED - 3"); 145 END IF; 146 EXCEPTION 147 WHEN PROGRAM_ERROR => 148 NULL; 149 WHEN OTHERS => 150 FAILED ("UNEXPECTED EXCEPTION RAISED - 3"); 151 END P; 152 153 PROCEDURE ADD1 (A : IN OUT INTEGER) IS 154 BEGIN 155 A := A + IDENT_INT(1); 156 END ADD1; 157 158 BEGIN 159 NULL; 160 END; 161 162 RESULT; 163END C39006B; 164