diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxh/cxh3002.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxh/cxh3002.a | 343 |
1 files changed, 0 insertions, 343 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a b/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a deleted file mode 100644 index 5e9f7b9cc9e..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a +++ /dev/null @@ -1,343 +0,0 @@ --- CXH3002.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 that pragma Inspection_Point is allowed whereever a declarative --- item or statement is allowed. Check that pragma Inspection_Point may --- have zero or more arguments. Check that the execution of pragma --- Inspection_Point has no effect. --- --- TEST DESCRIPTION --- Check pragma Inspection_Point applied to: --- A no objects, --- B one object, --- C multiple objects. --- Check pragma Inspection_Point applied to: --- D Enumeration type objects, --- E Integer type objects (signed and unsigned), --- F access type objects, --- G Floating Point type objects, --- H Fixed point type objects, --- I array type objects, --- J record type objects, --- K tagged type objects, --- L protected type objects, --- M controlled type objects, --- N task type objects. --- Check pragma Inspection_Point applied in: --- O declarations (package, procedure) --- P statements (incl package elaboration) --- Q subprogram (procedure, function, finalization) --- R package --- S specification --- T body (PO entry, task body, loop body, accept body, select body) --- U task --- V protected object --- --- --- APPLICABILITY CRITERIA: --- This test is only applicable for a compiler attempting validation --- for the Safety and Security Annex. --- --- --- CHANGE HISTORY: --- 26 OCT 95 SAIC Initial version --- 12 NOV 96 SAIC Revised for 2.1 --- ---! - ------------------------------------------------------------------ CXH3002_0 - -package CXH3002_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 record - I: Int; - U: Unt; - end record; - - type List is array(Unt) of Root(Stuff); - - type A_List is access all List; - type A_Proc is access procedure(R:Root); - - procedure Proc(R:Root); - function Func return A_Proc; - - protected type PT is - entry Prot_Entry(Switch: Boolean); - private - Toggle : Boolean := False; - end PT; - - task type TT is - entry Task_Entry(Items: in A_List); - end TT; - - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- AORS - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - -end CXH3002_0; - ------------------------------------------------------------------ CXH3002_1 - -with Ada.Finalization; -package CXH3002_0.CXH3002_1 is - - type Final is new Ada.Finalization.Controlled with - record - Value : Natural; - end record; - - procedure Initialize( F: in out Final ); - procedure Adjust( F: in out Final ); - procedure Finalize( F: in out Final ); - -end CXH3002_0.CXH3002_1; - --- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_0 - -package body CXH3002_0 is - - Global_Variable : Character := 'A'; - - procedure Proc(R:Root) is - begin - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point( Global_Variable ); -- BDPQT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - case R.Disc is - when Item => Global_Variable := 'I'; - when Stuff => Global_Variable := 'S'; - when Things => Global_Variable := 'T'; - end case; - end Proc; - - function Func return A_Proc is - begin - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- APQT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - return Proc'Access; - end Func; - - protected body PT is - entry Prot_Entry(Switch: Boolean) when True is - begin - Toggle := Switch; - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- APVT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - end Prot_Entry; - end PT; - - task body TT is - List_Copy : A_List; - begin - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- APUT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - loop - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- APUT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - select - accept Task_Entry(Items: in A_List) do - List_Copy := Items; - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point( List_Copy ); -- BFPUT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - end Task_Entry; - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- APUT - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - or terminate; - end select; - end loop; - end TT; - - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point; -- ARTO - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - -end CXH3002_0; - --- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- CXH3002_1 - -with Report; -package body CXH3002_0.CXH3002_1 is - - Embedded_Final_Object : Final - := (Ada.Finalization.Controlled with Value => 1); - -- attempt to call Initialize here would P_E! - - procedure Initialize( F: in out Final ) is - begin - F.Value := 1; - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point( Embedded_Final_Object ); -- BKQP - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - end Initialize; - - procedure Adjust( F: in out Final ) is - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point; -- AQO - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - begin - F.Value := 2; - end Adjust; - - procedure Finalize( F: in out Final ) is - begin - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- AQP - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - if F.Value not in 1..10 then - Report.Failed("Bad value in controlled object at finalization"); - end if; - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - pragma Inspection_Point; -- AQP - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---==== - end Finalize; - -begin - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====== - pragma Inspection_Point( Embedded_Final_Object ); -- BKRTP - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---====== - null; -end CXH3002_0.CXH3002_1; - -------------------------------------------------------------------- CXH3002 - -with Report; -with CXH3002_0.CXH3002_1; -procedure CXH3002 is - - use type CXH3002_0.Enum, CXH3002_0.Int, CXH3002_0.Unt, CXH3002_0.Flt, - CXH3002_0.Fix, CXH3002_0.Root; - - Main_Enum : CXH3002_0.Enum := CXH3002_0.Item; - Main_Int : CXH3002_0.Int; - Main_Unt : CXH3002_0.Unt; - Main_Flt : CXH3002_0.Flt; - Main_Fix : CXH3002_0.Fix; - Main_Rec : CXH3002_0.Root(CXH3002_0.Stuff) - := (CXH3002_0.Stuff, I => 1, U => 2); - - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - pragma Inspection_Point( Main_Rec ); -- BJQO - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---===== - - Main_List : CXH3002_0.List := ( others => Main_Rec ); - - Main_A_List : CXH3002_0.A_List := new CXH3002_0.List'( others => Main_Rec ); - Main_A_Proc : CXH3002_0.A_Proc := CXH3002_0.Func; - -- CXH3002_0.Proc'Access - Main_PT : CXH3002_0.PT; - Main_TT : CXH3002_0.TT; - - type Test_Range is (First, Second); - - procedure Assert( Truth : Boolean; Message : String ) is - begin - if not Truth then - Report.Failed( "Unexpected value found in " & Message ); - end if; - end Assert; - -begin -- Main test procedure. - - Report.Test ("CXH3002", "Check pragma Inspection_Point" ); - - Enclosure:declare - Main_Final : CXH3002_0.CXH3002_1.Final; - Xtra_Final : CXH3002_0.CXH3002_1.Final; - begin - for Test_Case in Test_Range loop - - - case Test_Case is - when First => - Main_Final.Value := 5; - Xtra_Final := Main_Final; -- call Adjust - Main_Enum := CXH3002_0.Things; - Main_Int := CXH3002_0.Int'First; - Main_Unt := CXH3002_0.Unt'Last; - Main_Flt := 3.14; - Main_Fix := 0.5; - Main_Rec := (CXH3002_0.Stuff, I => 3, U => 4); - Main_List(Main_Unt) := Main_Rec; - Main_A_List(CXH3002_0.Unt'First) := (CXH3002_0.Stuff, I => 5, U => 6); - Main_A_Proc( Main_A_List(2) ); - Main_PT.Prot_Entry(True); - Main_TT.Task_Entry( null ); - - when Second => - Assert( Main_Final.Value = 5, "Main_Final" ); - Assert( Xtra_Final.Value = 2, "Xtra_Final" ); - Assert( Main_Enum = CXH3002_0.Things, "Main_Enum" ); - Assert( Main_Int = CXH3002_0.Int'First, "Main_Int" ); - Assert( Main_Unt = CXH3002_0.Unt'Last, "Main_Unt" ); - Assert( Main_Flt in 3.0..3.5, "Main_Flt" ); - Assert( Main_Fix = 0.5, "Main_Fix" ); - Assert( Main_Rec = (CXH3002_0.Stuff, I => 3, U => 4), "Main_Rec" ); - Assert( Main_List(Main_Unt) = Main_Rec, "Main_List" ); - Assert( Main_A_List(CXH3002_0.Unt'First) - = (CXH3002_0.Stuff, I => 5, U => 6), "Main_A_List" ); - - end case; - - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---== - pragma Inspection_Point( -- CQP - Main_Final, -- M - Main_Enum, -- D - Main_Int, -- E - Main_Unt, -- E - Main_Flt, -- G - Main_Fix, -- H - Main_Rec, -- J - Main_List, -- I - Main_A_List, -- F - Main_A_Proc, -- F - Main_PT, -- L - Main_TT ); -- N - -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- ---== - - end loop; - end Enclosure; - - Report.Result; - -end CXH3002; |