1-- C39006F2.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 NO PROGRAM_ERROR IS RAISED IF A SUBPROGRAM'S BODY HAS 27-- BEEN ELABORATED BEFORE IT IS CALLED. CHECK THE FOLLOWING: 28-- B) FOR A SUBPROGRAM LIBRARY UNIT USED IN ANOTHER UNIT, NO 29-- PROGRAM_ERROR IS RAISED IF PRAGMA ELABORATE NAMES THE 30-- SUBPROGRAM. 31 32-- THIS LIBRARY PACKAGE BODY IS USED BY C39006F3M.ADA. 33 34-- HISTORY: 35-- TBN 08/22/86 CREATED ORIGINAL TEST. 36-- BCB 03/29/90 CORRECTED HEADER. CHANGED TEST NAME IN CALL 37-- TO 'TEST'. 38-- PWN 05/25/94 ADDED A PROCEDURE TO KEEP PACKAGE BODIES LEGAL. 39 40WITH C39006F0; 41WITH REPORT; USE REPORT; 42PRAGMA ELABORATE (C39006F0, REPORT); 43 44PACKAGE BODY C39006F1 IS 45 46 PROCEDURE REQUIRE_BODY IS 47 BEGIN 48 NULL; 49 END; 50 51BEGIN 52 TEST ("C39006F", "CHECK THAT NO PROGRAM_ERROR IS RAISED IF A " & 53 "SUBPROGRAM'S BODY HAS BEEN ELABORATED " & 54 "BEFORE IT IS CALLED, WHEN A SUBPROGRAM " & 55 "LIBRARY UNIT IS USED IN ANOTHER UNIT AND " & 56 "PRAGMA ELABORATE IS USED"); 57 BEGIN 58 DECLARE 59 VAR1 : INTEGER := C39006F0 (IDENT_INT(1)); 60 BEGIN 61 IF VAR1 /= IDENT_INT(1) THEN 62 FAILED ("INCORRECT RESULTS - 1"); 63 END IF; 64 END; 65 EXCEPTION 66 WHEN PROGRAM_ERROR => 67 FAILED ("PROGRAM_ERROR RAISED - 1"); 68 WHEN OTHERS => 69 FAILED ("UNEXPECTED EXCEPTION RAISED - 1"); 70 END; 71 72 DECLARE 73 VAR2 : INTEGER := 1; 74 75 PROCEDURE CHECK (B : IN OUT INTEGER) IS 76 BEGIN 77 B := C39006F0 (IDENT_INT(2)); 78 EXCEPTION 79 WHEN PROGRAM_ERROR => 80 FAILED ("PROGRAM_ERROR RAISED - 2"); 81 WHEN OTHERS => 82 FAILED ("UNEXPECTED EXCEPTION RAISED - 2"); 83 END CHECK; 84 BEGIN 85 CHECK (VAR2); 86 IF VAR2 /= IDENT_INT(2) THEN 87 FAILED ("INCORRECT RESULTS - 2"); 88 END IF; 89 END; 90 91 DECLARE 92 PACKAGE P IS 93 VAR3 : INTEGER; 94 END P; 95 96 PACKAGE BODY P IS 97 BEGIN 98 VAR3 := C39006F0 (IDENT_INT(3)); 99 IF VAR3 /= IDENT_INT(3) THEN 100 FAILED ("INCORRECT RESULTS - 3"); 101 END IF; 102 EXCEPTION 103 WHEN PROGRAM_ERROR => 104 FAILED ("PROGRAM_ERROR RAISED - 3"); 105 WHEN OTHERS => 106 FAILED ("UNEXPECTED EXCEPTION - 3"); 107 END P; 108 BEGIN 109 NULL; 110 END; 111 112 DECLARE 113 GENERIC 114 VAR4 : INTEGER := 1; 115 PACKAGE Q IS 116 TYPE ARRAY_TYP1 IS ARRAY (1 .. VAR4) OF INTEGER; 117 ARRAY_1 : ARRAY_TYP1; 118 END Q; 119 120 PACKAGE NEW_Q IS NEW Q (C39006F0 (IDENT_INT(4))); 121 122 USE NEW_Q; 123 124 BEGIN 125 IF ARRAY_1'LAST /= IDENT_INT(4) THEN 126 FAILED ("INCORRECT RESULTS - 4"); 127 END IF; 128 END; 129 130END C39006F1; 131