1-- CA21001.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and 6-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the 7-- software and documentation contained herein. Unlimited rights are 8-- defined in DFAR 252.227-7013(a)(19). By making this public release, 9-- the Government intends to confer upon all recipients unlimited rights 10-- equal to those held by the Government. These rights include rights to 11-- use, duplicate, release or disclose the released technical data and 12-- computer software in whole or in part, in any manner and for any purpose 13-- whatsoever, and to have or permit others to do so. 14-- 15-- DISCLAIMER 16-- 17-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 18-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 19-- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE 20-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 21-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 22-- PARTICULAR PURPOSE OF SAID MATERIAL. 23--* 24-- 25-- OBJECTIVE 26-- Check the requirements of the revised 10.2.1(11) from Technical 27-- Corrigendum 1 (originally discussed as AI95-00002). 28-- A package subunit whose parent is a preelaborated subprogram need 29-- not be preelaborable. 30-- 31-- TEST DESCRIPTION 32-- We create several preelaborated library procedures with 33-- non-preelaborable package body subunits. We try various levels 34-- of nesting of package and procedure subunits. 35-- 36-- CHANGE HISTORY: 37-- 29 JUN 1999 RAD Initial Version 38-- 23 SEP 1999 RLB Improved comments, renamed, issued. 39-- 40--! 41 42procedure CA21001_1(X: out Integer); 43 pragma Preelaborate(CA21001_1); 44 45procedure CA21001_1(X: out Integer) is 46 function F return Integer is separate; 47 48 package Sub is 49 function G(X: Integer) return Integer; 50 -- Returns X + 1. 51 Not_Preelaborable: Integer := F; -- OK, by AI-2. 52 end Sub; 53 54 package body Sub is separate; 55 56begin 57 X := -1; 58 X := F; 59 X := Sub.G(X); 60end CA21001_1; 61 62separate(CA21001_1) 63package body Sub is 64 package Sub_Sub is 65 -- Empty. 66 end Sub_Sub; 67 package body Sub_Sub is separate; 68 69 function G(X: Integer) return Integer is separate; 70begin 71 Not_Preelaborable := G(F); -- OK, by AI-2. 72 if Not_Preelaborable /= 101 then 73 raise Program_Error; -- Can't call Report.Failed, here, 74 -- because Report is not preelaborated. 75 end if; 76end Sub; 77 78separate(CA21001_1.Sub) 79package body Sub_Sub is 80begin 81 X := X; -- OK by AI-2. 82end Sub_Sub; 83 84separate(CA21001_1.Sub) 85function G(X: Integer) return Integer is 86 87 package G_Sub is 88 function H(X: Integer) return Integer; 89 -- Returns X + 1. 90 Not_Preelaborable: Integer := F; -- OK, by AI-2. 91 end G_Sub; 92 package body G_Sub is separate; 93 94begin 95 return G_Sub.H(X); 96end G; 97 98separate(CA21001_1.Sub.G) 99package body G_Sub is 100 function H(X: Integer) return Integer is separate; 101begin 102 Not_Preelaborable := H(F); -- OK, by AI-2. 103 if Not_Preelaborable /= 101 then 104 raise Program_Error; -- Can't call Report.Failed, here, 105 -- because Report is not preelaborated. 106 end if; 107end G_Sub; 108 109separate(CA21001_1.Sub.G.G_Sub) 110function H(X: Integer) return Integer is 111begin 112 return X + 1; 113end H; 114 115separate(CA21001_1) 116function F return Integer is 117 118 package F_Sub is 119 -- Empty. 120 end F_Sub; 121 122 package body F_Sub is separate; 123begin 124 return 100; 125end F; 126 127separate(CA21001_1.F) 128package body F_Sub is 129 True_Var: Boolean; 130begin 131 True_Var := True; 132 if True_Var then -- OK by AI-2. 133 X := X; 134 else 135 X := X + 2; 136 end if; 137end F_Sub; 138 139with Report; use Report; 140with CA21001_1; 141procedure CA21001 is 142 X: Integer := 0; 143begin 144 Test("CA21001", 145 "Test that a package subunit whose parent is a preelaborated" 146 & " subprogram need not be preelaborable"); 147 CA21001_1(X); 148 if X /= 101 then 149 Failed("Bad value for X"); 150 end if; 151 Result; 152end CA21001; 153