1-- C39006D.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 IF A FUNCTION IS USED IN A DEFAULT EXPRESSION FOR A 26-- SUBPROGRAM OR FORMAL GENERIC PARAMETER, PROGRAM_ERROR IS RAISED 27-- WHEN AN ATTEMPT IS MADE TO EVALUATE THE DEFAULT EXPRESSION, 28-- BECAUSE THE FUNCTION'S BODY HAS NOT BEEN ELABORATED YET. 29 30-- TBN 8/20/86 31 32WITH REPORT; USE REPORT; 33PROCEDURE C39006D IS 34 35BEGIN 36 TEST ("C39006D", "CHECK THAT IF A FUNCTION IS USED IN A DEFAULT " & 37 "EXPRESSION FOR A SUBPROGRAM OR FORMAL GENERIC " & 38 "PARAMETER, PROGRAM_ERROR IS RAISED WHEN AN " & 39 "ATTEMPT IS MADE TO EVALUATE THE DEFAULT " & 40 "EXPRESSION"); 41 DECLARE 42 FUNCTION FUN RETURN INTEGER; 43 44 PACKAGE P IS 45 PROCEDURE DEFAULT (A : INTEGER := FUN); 46 END P; 47 48 PACKAGE BODY P IS 49 PROCEDURE DEFAULT (A : INTEGER := FUN) IS 50 B : INTEGER := 1; 51 BEGIN 52 B := B + IDENT_INT(A); 53 END DEFAULT; 54 BEGIN 55 DEFAULT (2); 56 DEFAULT; 57 FAILED ("PROGRAM_ERROR NOT RAISED - 1"); 58 EXCEPTION 59 WHEN PROGRAM_ERROR => 60 NULL; 61 WHEN OTHERS => 62 FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); 63 END P; 64 65 FUNCTION FUN RETURN INTEGER IS 66 BEGIN 67 RETURN (IDENT_INT(1)); 68 END FUN; 69 BEGIN 70 NULL; 71 END; 72 73 BEGIN 74 DECLARE 75 FUNCTION INIT_1 RETURN INTEGER; 76 77 GENERIC 78 LENGTH : INTEGER := INIT_1; 79 PACKAGE P IS 80 TYPE ARRAY1 IS ARRAY (1 .. LENGTH) OF INTEGER; 81 END P; 82 83 PACKAGE NEW_P1 IS NEW P (4); 84 PACKAGE NEW_P2 IS NEW P; 85 86 FUNCTION INIT_1 RETURN INTEGER IS 87 BEGIN 88 RETURN (IDENT_INT(2)); 89 END INIT_1; 90 91 BEGIN 92 FAILED ("PROGRAM_ERROR NOT RAISED - 2"); 93 END; 94 EXCEPTION 95 WHEN PROGRAM_ERROR => 96 NULL; 97 WHEN OTHERS => 98 FAILED ("UNEXPECTED EXCEPTION RAISED - 2"); 99 END; 100 101 DECLARE 102 FUNCTION INIT_2 RETURN INTEGER; 103 104 GLOBAL_INT : INTEGER := IDENT_INT(1); 105 106 GENERIC 107 PACKAGE Q IS 108 PROCEDURE ADD1 (A : INTEGER := INIT_2); 109 END Q; 110 111 PACKAGE BODY Q IS 112 PROCEDURE ADD1 (A : INTEGER := INIT_2) IS 113 B : INTEGER; 114 BEGIN 115 B := A; 116 END ADD1; 117 BEGIN 118 IF GLOBAL_INT = IDENT_INT(1) THEN 119 ADD1; 120 FAILED ("PROGRAM_ERROR NOT RAISED - 3"); 121 ELSE 122 ADD1 (2); 123 END IF; 124 125 EXCEPTION 126 WHEN PROGRAM_ERROR => 127 NULL; 128 WHEN OTHERS => 129 FAILED ("UNEXPECTED EXCEPTION RAISED - 3"); 130 END Q; 131 132 PACKAGE NEW_Q IS NEW Q; 133 134 FUNCTION INIT_2 RETURN INTEGER IS 135 BEGIN 136 RETURN (IDENT_INT(1)); 137 END INIT_2; 138 139 BEGIN 140 NULL; 141 END; 142 143 RESULT; 144END C39006D; 145