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