-- 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;