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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
-- CXH3001.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 pragma Reviewable.
-- Check that pragma Reviewable is accepted as a configuration pragma.
--
-- TEST DESCRIPTION
-- The test requires that the configuration pragma Reviewable
-- be processed. The following package contains a simple "one of each
-- construct in the language" to check that the configuration pragma has
-- not disallowed some feature of the language. This test should generate
-- no errors.
--
-- APPLICABILITY CRITERIA:
-- This test is only applicable for a compiler attempting validation
-- for the Safety and Security Annex.
--
-- PASS/FAIL CRITERIA:
-- This test passes if it correctly compiles, executes, and reports PASS.
-- It fails if the pragma is rejected. The effect of the pragma should
-- be to produce a listing with information, including warnings, as
-- required in H.3.1. Specific form and contents of this listing are not
-- required by this test and are not part of the PASS/FAIL criteria.
--
-- SPECIAL REQUIREMENTS
-- The implementation must process a configuration pragma which is not
-- part of any Compilation Unit; the method employed is implementation
-- defined.
--
-- Pragma Reviewable requires that the implementation provide the
-- following information for the compilation units in this test:
--
-- o Where compiler-generated run-time checks remain (6)
--
-- o Identification of any construct with a language-defined check
-- that is recognized prior to runtime as certain to fail if
-- executed (7)
--
-- o For each reference to a scalar object, an identification of
-- the reference as either "known to be initialized,"
-- or "possibly uninitialized" (8)
--
-- o Where run-time support routines are implicitly invoked (9)
--
-- o An object code listing including: (10)
--
-- o Machine instructions with relative offsets (11)
--
-- o Where each data object is stored during its lifetime (12)
--
-- o Correspondence with the source program (13)
--
-- o Identification of each construct for which the implementation
-- detects the possibility of erroneous execution (14)
--
-- o For each subprogram, block, task or other construct implemented by
-- reserving and subsequently freezing an area of the run-time stack,
-- an identification of the length of the fixed-size portion of
-- the area and an indication of whether the non-fixed size portion
-- is reserved on the stack or in a dynamically managed storage
-- region (15)
--
--
-- CHANGE HISTORY:
-- 26 OCT 95 SAIC Initial version
-- 12 NOV 96 SAIC Revised for 2.1
-- 27 AUG 99 RLB Removed result dependence on uninitialized object.
-- 30 AUG 99 RLB Repaired the above.
--
--!
---------------------------- CONFIGURATION PRAGMAS -----------------------
pragma Reviewable; -- OK
-- configuration pragma
------------------------ END OF CONFIGURATION PRAGMAS --------------------
----------------------------------------------------------------- CXH3001_0
package CXH3001_0 is
type Enum is (Item,Stuff,Things);
type Int is range 0..256;
type Unt is mod 256;
type Flt is digits 5;
type Fix is delta 0.5 range -1.0..1.0;
type Root(Disc: Enum) is tagged record
I: Int; U:Unt;
end record;
type List is array(Unt) of Root(Stuff);
type A_List is access List;
type A_Proc is access procedure(R:Root);
procedure P(R:Root);
function F return A_Proc;
protected PT is
entry Set(Switch: Boolean);
function Enquire return Boolean;
private
Toggle : Boolean;
end PT;
task TT is
entry Release;
end TT;
Global_Variable : Boolean := False;
end CXH3001_0;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
with Report;
package body CXH3001_0 is
procedure P(R:Root) is
Warnable : Positive := 0; -- (7) -- OPTIONAL WARNING
-- this would raise Constraint_Error if P were ever called, however
-- this test never calls P.
begin
case R.Disc is
when Item => Report.Comment("Got Item");
when Stuff => Report.Comment("Got Stuff");
when Things => Report.Comment("Got Things");
end case;
if Report.Ident_Int( Warnable ) = 0 then
Global_Variable := not Global_Variable; -- (8) known to be initialized
end if;
end P;
function F return A_Proc is
begin
return P'Access;
end F;
protected body PT is
entry Set(Switch: Boolean) when True is
begin
Toggle := Switch;
end Set;
function Enquire return Boolean is
begin
return Toggle;
end Enquire;
end PT;
task body TT is
begin
loop
accept Release;
exit when Global_Variable;
end loop;
end TT;
-- (9) TT activation
end CXH3001_0;
------------------------------------------------------------------- CXH3001
with Report;
with CXH3001_0;
procedure CXH3001 is
begin
Report.Test("CXH3001", "Check pragma Reviewable as a configuration pragma");
Block: declare
A_Truth : Boolean;
Message : String := Report.Ident_Str( "Bad value encountered" );
begin
begin
A_Truth := Report.Ident_Bool( True ) or A_Truth; -- (8) not initialized
if not A_Truth then
Report.Comment ("True or Uninit = False");
A_Truth := Report.Ident_Bool (True);
else
A_Truth := Report.Ident_Bool (True);
-- We do this separately on each branch in order to insure that a
-- clever optimizer can find out little about this value. Ident_Bool
-- is supposed to be opaque to any optimizer.
end if;
exception
when Constraint_Error | Program_Error =>
-- Possible results of accessing an uninitialized object.
A_Truth := Report.Ident_Bool (True);
end;
CXH3001_0.PT.Set( A_Truth );
CXH3001_0.Global_Variable := A_Truth;
CXH3001_0.TT.Release; -- (9) rendezvous with TT
while CXH3001_0.TT'Callable loop
delay 1.0; -- wait for TT to become non-callable
end loop;
if not CXH3001_0.PT.Enquire
or not CXH3001_0.Global_Variable
or CXH3001_0.TT'Callable then
Report.Failed(Message);
end if;
end Block;
Report.Result;
end CXH3001;
|
