1-- CA15003.A 2-- Grant of Unlimited Rights 3-- 4-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 5-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 6-- unlimited rights in the software and documentation contained herein. 7-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 8-- this public release, the Government intends to confer upon all 9-- recipients unlimited rights equal to those held by the Government. 10-- These rights include rights to use, duplicate, release or disclose the 11-- released technical data and computer software in whole or in part, in 12-- any manner and for any purpose whatsoever, and to have or permit others 13-- 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 WHATSOEVER, 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 10.1.5(4) and the modified 10.1.5(5) 27-- from Technical Corrigendum 1. (Originally discussed as AI95-00136.) 28-- Specifically: 29-- Check that program unit pragma for a generic package are accepted 30-- when given at the beginning of the package specification. 31-- Check that a program unit pragma can be given for a generic 32-- instantiation by placing the pragma immediately after the instantation. 33-- 34-- TEST DESCRIPTION 35-- This test checks the cases that are *not* forbidden by the RM, 36-- and makes sure such legal cases actually work. 37-- 38-- CHANGE HISTORY: 39-- 29 JUN 1999 RAD Initial Version 40-- 08 JUL 1999 RLB Cleaned up and added to test suite. 41-- 27 AUG 1999 RLB Repaired errors introduced by me. 42-- 43--! 44 45with System; 46package CA15003A is 47 pragma Pure; 48 49 type Big_Int is range -System.Max_Int .. System.Max_Int; 50 type Big_Positive is new Big_Int range 1..Big_Int'Last; 51end CA15003A; 52 53generic 54 type Int is new Big_Int; 55package CA15003A.Pure is 56 pragma Pure; 57 function F(X: access Int) return Int; 58end CA15003A.Pure; 59 60with CA15003A.Pure; 61package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive); 62 pragma Pure(CA15003A.Pure_Instance); 63 64package body CA15003A.Pure is 65 function F(X: access Int) return Int is 66 begin 67 X.all := X.all + 1; 68 return X.all; 69 end F; 70end CA15003A.Pure; 71 72generic 73package CA15003A.Pure.Preelaborate is 74 pragma Preelaborate; 75 One: Int := 1; 76 function F(X: access Int) return Int; 77end CA15003A.Pure.Preelaborate; 78 79package body CA15003A.Pure.Preelaborate is 80 function F(X: access Int) return Int is 81 begin 82 X.all := X.all + One; 83 return X.all; 84 end F; 85end CA15003A.Pure.Preelaborate; 86 87with CA15003A.Pure_Instance; 88with CA15003A.Pure.Preelaborate; 89package CA15003A.Pure_Preelaborate_Instance is 90 new CA15003A.Pure_Instance.Preelaborate; 91 pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance); 92 93package CA15003A.Empty_Pure is 94 pragma Pure; 95 pragma Elaborate_Body; 96end CA15003A.Empty_Pure; 97 98package body CA15003A.Empty_Pure is 99end CA15003A.Empty_Pure; 100 101package CA15003A.Empty_Preelaborate is 102 pragma Preelaborate; 103 pragma Elaborate_Body; 104 One: Big_Int := 1; 105end CA15003A.Empty_Preelaborate; 106 107package body CA15003A.Empty_Preelaborate is 108 function F(X: access Big_Int) return Big_Int is 109 begin 110 X.all := X.all + One; 111 return X.all; 112 end F; 113end CA15003A.Empty_Preelaborate; 114 115package CA15003A.Empty_Elaborate_Body is 116 pragma Elaborate_Body; 117 Three: aliased Big_Positive := 1; 118 Two, Tres: Big_Positive'Base := 0; 119end CA15003A.Empty_Elaborate_Body; 120 121with Report; use Report; pragma Elaborate_All(Report); 122with CA15003A.Pure_Instance; 123with CA15003A.Pure_Preelaborate_Instance; 124use CA15003A; 125package body CA15003A.Empty_Elaborate_Body is 126begin 127 if Two /= Big_Positive'Base(Ident_Int(0)) then 128 Failed ("Two should be zero now"); 129 end if; 130 if Tres /= Big_Positive'Base(Ident_Int(0)) then 131 Failed ("Tres should be zero now"); 132 end if; 133 if Two /= Tres then 134 Failed ("Tres should be zero now"); 135 end if; 136 Two := Pure_Instance.F(Three'Access); 137 Tres := Pure_Preelaborate_Instance.F(Three'Access); 138 if Two /= Big_Positive(Ident_Int(2)) then 139 Failed ("Two should be 2 now"); 140 end if; 141 if Tres /= Big_Positive(Ident_Int(3)) then 142 Failed ("Tres should be 3 now"); 143 end if; 144end CA15003A.Empty_Elaborate_Body; 145 146with Report; use Report; 147with CA15003A.Empty_Pure; 148with CA15003A.Empty_Preelaborate; 149with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body; 150use type CA15003A.Big_Positive'Base; 151procedure CA15003 is 152begin 153 Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages"); 154 if Two /= 2 then 155 Failed ("Two should be 2 now"); 156 end if; 157 if Tres /= 3 then 158 Failed ("Tres should be 3 now"); 159 end if; 160 Result; 161end CA15003; 162