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
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
-- F750A00.A
--
-- Grant of Unlimited Rights
--
-- The Ada Conformity Assessment Authority (ACAA) holds unlimited
-- rights in the software and documentation contained herein. Unlimited
-- rights are the same as those granted by the U.S. Government for older
-- parts of the Ada Conformity Assessment Test Suite, and are defined
-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
-- intends to confer upon all recipients unlimited rights equal to those
-- held by the ACAA. 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 ACAA 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.
--
-- Notice
--
-- The ACAA has created and maintains the Ada Conformity Assessment Test
-- Suite for the purpose of conformity assessments conducted in accordance
-- with the International Standard ISO/IEC 18009 - Ada: Conformity
-- assessment of a language processor. This test suite should not be used
-- to make claims of conformance unless used in accordance with
-- ISO/IEC 18009 and any applicable ACAA procedures.
--*
--
-- FOUNDATION DESCRIPTION:
-- This foundation declares limited types, operations, and objects
-- for use in tests checking the limitations on use of limited
-- expression.
--
-- CHANGE HISTORY:
-- 30 Apr 07 RLB Created.
-- 17 Aug 07 RLB Moved primitive function Func_Lim_Ext_Access before
-- freezing point.
--
--!
package F750A00 is
type Lim_Rec is limited record
A : Integer;
B : Boolean;
end record;
function Func_Lim_Rec return Lim_Rec;
Cnst_Lim_Rec : constant Lim_Rec := (A => 10, B => True);
Var_Lim_Rec : Lim_Rec := (A => 22, B => False);
type Lim_Array is array (Positive range <>) of Lim_Rec;
subtype Short_Lim_Array is Lim_Array (1..3);
function Func_Lim_Array return Short_Lim_Array;
Cnst_Lim_Array : constant Lim_Array := (1 .. 3 => (A => 4, B => False));
Var_Lim_Array : constant Lim_Array := (1 .. 3 => (A => 5, B => False));
type Lim_Tagged is tagged limited record
R : Lim_Rec;
N : Natural;
end record;
function Func_New_One return Lim_Tagged;
type Lim_Ext is new Lim_Tagged with record
G : Natural;
end record;
type Any_Tagged_Access is access all Lim_Tagged'Class;
function Func_Lim_Tagged (Ext : in Boolean) return Lim_Tagged'Class;
function Func_New_One return Lim_Ext;
function Func_Lim_Ext return Lim_Ext;
function Func_Lim_Ext_Access return access Lim_Ext;
Cnst_Lim_Tagged : constant Lim_Tagged :=
(R => (A => 10, B => True), N => 92);
Cnst_Lim_Ext : constant Lim_Ext :=
(R => (A => 10, B => True), N => 36, G => 84);
Var_Lim_Tagged : aliased Lim_Tagged :=
(R => (A => 10, B => True), N => 92);
Var_Lim_Ext : aliased Lim_Ext :=
(R => (A => 10, B => True), N => 36, G => 84);
function Func_Lim_Tagged_Access (Ext : in Boolean) return Any_Tagged_Access;
Obj_Any_Tagged_Access : Any_Tagged_Access := Var_Lim_Tagged'Access;
Obj_Lim_Ext_Access : access Lim_Ext := Var_Lim_Ext'Access;
protected type Prot is
function Get return Natural;
procedure Set (Val : in Natural);
private
Value : Natural := 0;
end Prot;
type Lim_Comp is record
P : Prot;
N : Natural;
end record;
function Func_Lim_Comp return Lim_Comp;
Cnst_Lim_Comp : constant Lim_Comp := (N => 32, P => <>);
Var_Lim_Comp : Lim_Comp := (N => 98, P => <>);
end F750A00;
package body F750A00 is
function Func_Lim_Rec return Lim_Rec is
begin
return (A => 45, B => False);
end Func_Lim_Rec;
function Func_Lim_Array return Short_Lim_Array is
begin
return (1 .. 3 => (A => 4, B => False));
end Func_Lim_Array;
function Func_Lim_Tagged (Ext : in Boolean) return Lim_Tagged'Class is
begin
if Ext then
return Lim_Ext'(R => (A => 15, B => False), N => 31, G => 5);
else
return Lim_Tagged'(R => (A => 15, B => False), N => 31);
end if;
end Func_Lim_Tagged;
function Func_New_One return Lim_Tagged is
begin
return (R => (A => 4, B => False), N => 9);
end Func_New_One;
function Func_New_One return Lim_Ext is
begin
return (R => (A => 7, B => True), N => 5, G => 8);
end Func_New_One;
function Func_Lim_Ext return Lim_Ext is
begin
return (R => (A => 7, B => True), N => 5, G => 8);
end Func_Lim_Ext;
function Func_Lim_Tagged_Access (Ext : in Boolean) return Any_Tagged_Access is
begin
if Ext then
return Var_Lim_Ext'Access;
else
return Var_Lim_Tagged'Access;
end if;
end Func_Lim_Tagged_Access;
function Func_Lim_Ext_Access return access Lim_Ext is
begin
return Var_Lim_Ext'Access;
end Func_Lim_Ext_Access;
function Func_Lim_Comp return Lim_Comp is
begin
return (N => 382, P => <>);
end Func_Lim_Comp;
protected body Prot is
function Get return Natural is
begin
return Value;
end Get;
procedure Set (Val : in Natural) is
begin
Value := Val;
end Set;
end Prot;
end F750A00;
|
