1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
-- 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;
|
