obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 343 insertions, 0 deletions

diff --git a/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a b/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
new file mode 100644
index 000000000..5e9f7b9cc
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxh/cxh3002.a
@@ -0,0 +1,343 @@
+-- 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;