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
|
-- CXH30031.AM
--
-- 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
-- This test checks that pragma Reviewable is processed as a
-- configuration pragma. See CXH3001 for testing pragma Reviewable as
-- other than a configuration pragma.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- CXH30030.A
-- => CXH30031.AM
--
-- APPLICABILITY CRITERIA:
-- This test is only applicable for a compiler attempting validation
-- for the Safety and Security Annex.
--
-- SPECIAL REQUIREMENTS
-- The implementation must process a configuration pragma which is not
-- part of any Compilation Unit; the method employed is implementation
-- defined.
--
--
-- CHANGE HISTORY:
-- 26 OCT 95 SAIC Initial version for 2.1
-- 07 JUN 96 SAIC Revised by reviewer request
-- 03 NOV 96 SAIC Documentation revision
--
-- 03 NOV 96 Keith Documentation revision
-- 27 AUG 99 RLB Removed result dependence on uninitialized object.
-- 30 AUG 99 RLB Repaired the above.
--
--!
pragma Reviewable;
----------------------------------------------------------------- CXH3003_0
package CXH3003_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;
Global_Variable : Boolean := False;
end CXH3003_0;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
with Report;
package body CXH3003_0 is
procedure P(R:Root) is
Warnable : Positive := 0; -- OPTIONAL WARNING
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; -- known to be initialized
end if;
end P;
function F return A_Proc is
begin
return P'Access;
end F;
end CXH3003_0;
----------------------------------------------------------------- CXH3003_1
package CXH3003_0.CXH3003_1 is
protected PT is
entry Set(Switch: Boolean);
function Enquire return Boolean;
private
Toggle : Boolean;
end PT;
task TT is
entry Release;
end TT;
end CXH3003_0.CXH3003_1;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
package body CXH3003_0.CXH3003_1 is
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;
-- TT activation
end CXH3003_0.CXH3003_1;
------------------------------------------------------------------- CXH3003
with Report;
with CXH3003_0.CXH3003_1;
procedure CXH30031 is
begin
Report.Test("CXH3003", "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; -- 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;
CXH3003_0.CXH3003_1.PT.Set( A_Truth );
CXH3003_0.Global_Variable := A_Truth;
CXH3003_0.CXH3003_1.TT.Release; -- rendezvous with TT
while CXH3003_0.CXH3003_1.TT'Callable loop -- wait for TT to complete
delay 1.0;
end loop;
if not CXH3003_0.CXH3003_1.PT.Enquire
or not CXH3003_0.Global_Variable then
Report.Failed(Message);
end if;
end Block;
Report.Result;
end CXH30031;
|
