1-- CXH30031.AM
2--
3--                             Grant of Unlimited Rights
4--
5--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7--     unlimited rights in the software and documentation contained herein.
8--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9--     this public release, the Government intends to confer upon all
10--     recipients unlimited rights  equal to those held by the Government.
11--     These rights include rights to use, duplicate, release or disclose the
12--     released technical data and computer software in whole or in part, in
13--     any manner and for any purpose whatsoever, and to have or permit others
14--     to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23--     PARTICULAR PURPOSE OF SAID MATERIAL.
24--*
25--
26-- OBJECTIVE
27--     Check pragma Reviewable.
28--     Check that pragma Reviewable is accepted as a configuration pragma.
29--
30-- TEST DESCRIPTION
31--     This test checks that pragma Reviewable is processed as a
32--     configuration pragma.  See CXH3001 for testing pragma Reviewable as
33--     other than a configuration pragma.
34--
35-- TEST FILES:
36--      The following files comprise this test:
37--
38--         CXH30030.A
39--      => CXH30031.AM
40--
41-- APPLICABILITY CRITERIA:
42--      This test is only applicable for a compiler attempting validation
43--      for the Safety and Security Annex.
44--
45-- SPECIAL REQUIREMENTS
46--      The implementation must process a configuration pragma which is not
47--      part of any Compilation Unit; the method employed is implementation
48--      defined.
49--
50--
51-- CHANGE HISTORY:
52--      26 OCT 95   SAIC   Initial version for 2.1
53--      07 JUN 96   SAIC   Revised by reviewer request
54--      03 NOV 96   SAIC   Documentation revision
55--
56--      03 NOV 96   Keith  Documentation revision
57--      27 AUG 99   RLB    Removed result dependence on uninitialized object.
58--      30 AUG 99   RLB    Repaired the above.
59--
60--!
61
62  pragma Reviewable;
63
64----------------------------------------------------------------- CXH3003_0
65
66package CXH3003_0 is
67
68  type Enum is (Item,Stuff,Things);
69
70  type Int is range 0..256;
71
72  type Unt is mod 256;
73
74  type Flt is digits 5;
75
76  type Fix is delta 0.5 range -1.0..1.0;
77
78  type Root(Disc: Enum) is tagged record
79    I: Int; U:Unt;
80  end record;
81
82  type List is array(Unt) of Root(Stuff);
83
84  type A_List is access List;
85  type A_Proc is access procedure(R:Root);
86
87  procedure P(R:Root);
88
89  function F return A_Proc;
90
91  Global_Variable : Boolean := False;
92
93end CXH3003_0;
94
95-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
96with Report;
97package body CXH3003_0 is
98
99 procedure P(R:Root) is
100    Warnable : Positive := 0;                             -- OPTIONAL WARNING
101  begin
102    case R.Disc is
103      when Item   => Report.Comment("Got Item");
104      when Stuff  => Report.Comment("Got Stuff");
105      when Things => Report.Comment("Got Things");
106    end case;
107    if Report.Ident_Int( Warnable ) = 0 then
108      Global_Variable := not Global_Variable;     -- known to be initialized
109    end if;
110  end P;
111
112  function F return A_Proc is
113  begin
114    return P'Access;
115  end F;
116
117end CXH3003_0;
118
119----------------------------------------------------------------- CXH3003_1
120
121package CXH3003_0.CXH3003_1 is
122
123  protected PT is
124    entry Set(Switch: Boolean);
125    function Enquire return Boolean;
126  private
127    Toggle : Boolean;
128  end PT;
129
130  task TT is
131    entry Release;
132  end TT;
133
134end CXH3003_0.CXH3003_1;
135
136-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
137
138package body CXH3003_0.CXH3003_1 is
139
140  protected body PT is
141
142    entry Set(Switch: Boolean) when True is
143    begin
144      Toggle := Switch;
145    end Set;
146
147    function Enquire return Boolean is
148    begin
149      return Toggle;
150    end Enquire;
151
152  end PT;
153
154  task body TT is
155  begin
156    loop
157      accept Release;
158      exit when Global_Variable;
159    end loop;
160  end TT;
161
162 -- TT activation
163
164end CXH3003_0.CXH3003_1;
165
166------------------------------------------------------------------- CXH3003
167
168with Report;
169with CXH3003_0.CXH3003_1;
170procedure CXH30031 is
171begin
172
173  Report.Test("CXH3003", "Check pragma Reviewable as a configuration pragma");
174
175  Block: declare
176    A_Truth : Boolean;
177    Message : String := Report.Ident_Str( "Bad value encountered" );
178  begin
179    begin
180      A_Truth := Report.Ident_Bool( True ) or A_Truth;  -- not initialized
181      if not A_Truth then
182        Report.Comment ("True or Uninit = False");
183        A_Truth := Report.Ident_Bool (True);
184      else
185        A_Truth := Report.Ident_Bool (True);
186          -- We do this separately on each branch in order to insure that a
187          -- clever optimizer can find out little about this value. Ident_Bool
188          -- is supposed to be opaque to any optimizer.
189      end if;
190    exception
191      when Constraint_Error | Program_Error =>
192           -- Possible results of accessing an uninitialized object.
193        A_Truth := Report.Ident_Bool (True);
194    end;
195
196    CXH3003_0.CXH3003_1.PT.Set( A_Truth );
197
198    CXH3003_0.Global_Variable := A_Truth;
199
200    CXH3003_0.CXH3003_1.TT.Release;  -- rendezvous with TT
201
202    while CXH3003_0.CXH3003_1.TT'Callable loop  -- wait for TT to complete
203      delay 1.0;
204    end loop;
205
206    if   not CXH3003_0.CXH3003_1.PT.Enquire
207      or not CXH3003_0.Global_Variable then
208      Report.Failed(Message);
209    end if;
210
211  end Block;
212
213  Report.Result;
214
215end CXH30031;
216