| -- CA15003.A |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- |
| -- OBJECTIVE |
| -- Check the requirements of 10.1.5(4) and the modified 10.1.5(5) |
| -- from Technical Corrigendum 1. (Originally discussed as AI95-00136.) |
| -- Specifically: |
| -- Check that program unit pragma for a generic package are accepted |
| -- when given at the beginning of the package specification. |
| -- Check that a program unit pragma can be given for a generic |
| -- instantiation by placing the pragma immediately after the instantation. |
| -- |
| -- TEST DESCRIPTION |
| -- This test checks the cases that are *not* forbidden by the RM, |
| -- and makes sure such legal cases actually work. |
| -- |
| -- CHANGE HISTORY: |
| -- 29 JUN 1999 RAD Initial Version |
| -- 08 JUL 1999 RLB Cleaned up and added to test suite. |
| -- 27 AUG 1999 RLB Repaired errors introduced by me. |
| -- |
| --! |
| |
| with System; |
| package CA15003A is |
| pragma Pure; |
| |
| type Big_Int is range -System.Max_Int .. System.Max_Int; |
| type Big_Positive is new Big_Int range 1..Big_Int'Last; |
| end CA15003A; |
| |
| generic |
| type Int is new Big_Int; |
| package CA15003A.Pure is |
| pragma Pure; |
| function F(X: access Int) return Int; |
| end CA15003A.Pure; |
| |
| with CA15003A.Pure; |
| package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive); |
| pragma Pure(CA15003A.Pure_Instance); |
| |
| package body CA15003A.Pure is |
| function F(X: access Int) return Int is |
| begin |
| X.all := X.all + 1; |
| return X.all; |
| end F; |
| end CA15003A.Pure; |
| |
| generic |
| package CA15003A.Pure.Preelaborate is |
| pragma Preelaborate; |
| One: Int := 1; |
| function F(X: access Int) return Int; |
| end CA15003A.Pure.Preelaborate; |
| |
| package body CA15003A.Pure.Preelaborate is |
| function F(X: access Int) return Int is |
| begin |
| X.all := X.all + One; |
| return X.all; |
| end F; |
| end CA15003A.Pure.Preelaborate; |
| |
| with CA15003A.Pure_Instance; |
| with CA15003A.Pure.Preelaborate; |
| package CA15003A.Pure_Preelaborate_Instance is |
| new CA15003A.Pure_Instance.Preelaborate; |
| pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance); |
| |
| package CA15003A.Empty_Pure is |
| pragma Pure; |
| pragma Elaborate_Body; |
| end CA15003A.Empty_Pure; |
| |
| package body CA15003A.Empty_Pure is |
| end CA15003A.Empty_Pure; |
| |
| package CA15003A.Empty_Preelaborate is |
| pragma Preelaborate; |
| pragma Elaborate_Body; |
| One: Big_Int := 1; |
| end CA15003A.Empty_Preelaborate; |
| |
| package body CA15003A.Empty_Preelaborate is |
| function F(X: access Big_Int) return Big_Int is |
| begin |
| X.all := X.all + One; |
| return X.all; |
| end F; |
| end CA15003A.Empty_Preelaborate; |
| |
| package CA15003A.Empty_Elaborate_Body is |
| pragma Elaborate_Body; |
| Three: aliased Big_Positive := 1; |
| Two, Tres: Big_Positive'Base := 0; |
| end CA15003A.Empty_Elaborate_Body; |
| |
| with Report; use Report; pragma Elaborate_All(Report); |
| with CA15003A.Pure_Instance; |
| with CA15003A.Pure_Preelaborate_Instance; |
| use CA15003A; |
| package body CA15003A.Empty_Elaborate_Body is |
| begin |
| if Two /= Big_Positive'Base(Ident_Int(0)) then |
| Failed ("Two should be zero now"); |
| end if; |
| if Tres /= Big_Positive'Base(Ident_Int(0)) then |
| Failed ("Tres should be zero now"); |
| end if; |
| if Two /= Tres then |
| Failed ("Tres should be zero now"); |
| end if; |
| Two := Pure_Instance.F(Three'Access); |
| Tres := Pure_Preelaborate_Instance.F(Three'Access); |
| if Two /= Big_Positive(Ident_Int(2)) then |
| Failed ("Two should be 2 now"); |
| end if; |
| if Tres /= Big_Positive(Ident_Int(3)) then |
| Failed ("Tres should be 3 now"); |
| end if; |
| end CA15003A.Empty_Elaborate_Body; |
| |
| with Report; use Report; |
| with CA15003A.Empty_Pure; |
| with CA15003A.Empty_Preelaborate; |
| with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body; |
| use type CA15003A.Big_Positive'Base; |
| procedure CA15003 is |
| begin |
| Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages"); |
| if Two /= 2 then |
| Failed ("Two should be 2 now"); |
| end if; |
| if Tres /= 3 then |
| Failed ("Tres should be 3 now"); |
| end if; |
| Result; |
| end CA15003; |