diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxh/cxh3001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxh/cxh3001.a | 243 |
1 files changed, 0 insertions, 243 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a b/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a deleted file mode 100644 index 4ed41b4d06f..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxh/cxh3001.a +++ /dev/null @@ -1,243 +0,0 @@ --- 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; |