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