2010-10-07 Ed Schonberg <schonberg@adacore.com>

	* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
	sequence of statements.

2010-10-07  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (Check_Files): Only add a .ci files if it exists

2010-10-07  Javier Miranda  <miranda@adacore.com>

	* a-tags.ads, a-tags.adb (Type_Is_Abstract): New subprogram.
	* rtsfind.ads (RE_Type_Is_Abstract): New entity.
	* exp_disp.adb (Make_DT): Initialize TSD component Type_Is_Abstract.

2010-10-07  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch12.adb (Mark_Context): Removed, no longer needed.
	(Analyze_Package_Instantiation): No longer analyze systematically a
	generic body in CodePeer mode.
	* freeze.adb, sem_attr.adb: Update comments.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165081 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 110 insertions, 152 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 679a3350ba1..cf3c16d3e9b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2010-10-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch5.adb (P_Sequence_Of_Statements): In Ada2012 a label can end a
+	sequence of statements.
+
+2010-10-07  Vincent Celier  <celier@adacore.com>
+
+	* gnatcmd.adb (Check_Files): Only add a .ci files if it exists
+
+2010-10-07  Javier Miranda  <miranda@adacore.com>
+
+	* a-tags.ads, a-tags.adb (Type_Is_Abstract): New subprogram.
+	* rtsfind.ads (RE_Type_Is_Abstract): New entity.
+	* exp_disp.adb (Make_DT): Initialize TSD component Type_Is_Abstract.
+
+2010-10-07  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_ch12.adb (Mark_Context): Removed, no longer needed.
+	(Analyze_Package_Instantiation): No longer analyze systematically a
+	generic body in CodePeer mode.
+	* freeze.adb, sem_attr.adb: Update comments.
+
 2010-10-05  Robert Dewar  <dewar@adacore.com>
 
 	* par-ch5.adb (Test_Statement_Required): Allow all pragmas in Ada 2012
diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 07b8e223e86..6f6a8aa02de 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -949,6 +949,24 @@ package body Ada.Tags is
       SSD (T).SSD_Table (Position).Kind := Value;
    end Set_Prim_Op_Kind;
 
+   ----------------------
+   -- Type_Is_Abstract --
+   ----------------------
+
+   function Type_Is_Abstract (T : Tag) return Boolean is
+      TSD_Ptr : Addr_Ptr;
+      TSD     : Type_Specific_Data_Ptr;
+
+   begin
+      if T = No_Tag then
+         raise Tag_Error;
+      end if;
+
+      TSD_Ptr := To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+      TSD     := To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+      return TSD.Type_Is_Abstract;
+   end Type_Is_Abstract;
+
    ------------------------
    -- Wide_Expanded_Name --
    ------------------------
diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads
index 7ef214bf83c..e03d58d4f83 100644
--- a/gcc/ada/a-tags.ads
+++ b/gcc/ada/a-tags.ads
@@ -75,6 +75,9 @@ package Ada.Tags is
    function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
    pragma Ada_05 (Interface_Ancestor_Tags);
 
+   function Type_Is_Abstract (T : Tag) return Boolean;
+   pragma Ada_05 (Type_Is_Abstract);
+
    Tag_Error : exception;
 
 private
@@ -103,6 +106,8 @@ private
    --                                    +-------------------+
    --                                    |   transportable   |
    --                                    +-------------------+
+   --                                    |  type_is_abstract |
+   --                                    +-------------------+
    --                                    | rec ctrler offset |
    --                                    +-------------------+
    --                                    |   Ifaces_Table   ---> Interface Data
@@ -280,6 +285,9 @@ private
       --  for being used in remote calls as actuals for classwide formals or as
       --  return values for classwide functions.
 
+      Type_Is_Abstract : Boolean;
+      --  True if the type is abstract (Ada 2012: AI05-0173)
+
       RC_Offset : SSE.Storage_Offset;
       --  Controller Offset: Used to give support to tagged controlled objects
       --  (see Get_Deep_Controller at s-finimp)
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index b5a464286a3..7e0cba54a0d 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4679,6 +4679,7 @@ package body Exp_Disp is
       --            External_Tag       => Cstring_Ptr!(Exname'Address))
       --            HT_Link            => HT_Link'Address,
       --            Transportable      => <<boolean-value>>,
+      --            Type_Is_Abstract   => <<boolean-value>>,
       --            RC_Offset          => <<integer-value>>,
       --            [ Size_Func         => Size_Prim'Access ]
       --            [ Interfaces_Table  => <<access-value>> ]
@@ -4945,6 +4946,22 @@ package body Exp_Disp is
             New_Occurrence_Of (Transportable, Loc));
       end;
 
+      --  Type_Is_Abstract (Ada 2012: AI05-0173). This functionality is
+      --  not available in the HIE runtime.
+
+      if RTE_Record_Component_Available (RE_Type_Is_Abstract) then
+         declare
+            Type_Is_Abstract : Entity_Id;
+
+         begin
+            Type_Is_Abstract :=
+              Boolean_Literals (Is_Abstract_Type (Typ));
+
+            Append_To (TSD_Aggr_List,
+               New_Occurrence_Of (Type_Is_Abstract, Loc));
+         end;
+      end if;
+
       --  RC_Offset: These are the valid values and their meaning:
 
       --   >0: For simple types with controlled components is
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index bda6e79dab2..ff32684b9d7 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2249,7 +2249,9 @@ package body Freeze is
            and then Esize (Rec) >= Scalar_Component_Total_RM_Size
 
            --  Never do implicit packing in CodePeer mode since we don't do
-           --  any packing ever in this mode (why not???)
+           --  any packing in this mode, since this generates over-complex
+           --  code that confuses CodePeer, and in general, CodePeer does not
+           --  care about the internal representation of objects.
 
            and then not CodePeer_Mode
          then
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 855a08dcf0a..a91653cb94d 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -377,6 +377,7 @@ procedure GNATCmd is
 
          declare
             Proj : Project_List;
+            File : String_Access;
 
          begin
             --  Gnatstack needs to add the .ci file for the binder generated
@@ -389,7 +390,6 @@ procedure GNATCmd is
                   if Check_Project (Proj.Project, Project) then
                      declare
                         Main : String_List_Id;
-                        File : String_Access;
 
                      begin
                         --  Include binder generated files for main programs
@@ -541,8 +541,7 @@ procedure GNATCmd is
                         end if;
 
                         if not Subunit then
-                           Last_Switches.Increment_Last;
-                           Last_Switches.Table (Last_Switches.Last) :=
+                           File :=
                              new String'
                                (Get_Name_String
                                  (Unit.File_Names
@@ -551,6 +550,11 @@ procedure GNATCmd is
                                   (Get_Name_String
                                      (Unit.File_Names (Impl).Display_File),
                                    "ci"));
+
+                           if Is_Regular_File (File.all) then
+                              Last_Switches.Increment_Last;
+                              Last_Switches.Table (Last_Switches.Last) := File;
+                           end if;
                         end if;
                      end if;
 
@@ -562,8 +566,7 @@ procedure GNATCmd is
                      if Check_Project
                           (Unit.File_Names (Spec).Project, Project)
                      then
-                        Last_Switches.Increment_Last;
-                        Last_Switches.Table (Last_Switches.Last) :=
+                        File :=
                           new String'
                             (Get_Name_String
                               (Unit.File_Names
@@ -572,6 +575,11 @@ procedure GNATCmd is
                              MLib.Fil.Ext_To
                                (Get_Name_String (Unit.File_Names (Spec).File),
                                 "ci"));
+
+                        if Is_Regular_File (File.all) then
+                           Last_Switches.Increment_Last;
+                           Last_Switches.Table (Last_Switches.Last) := File;
+                        end if;
                      end if;
                   end if;
 
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 428dc7890aa..f18197e0c13 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -83,7 +83,8 @@ package body Ch5 is
    -- 5.1  Sequence of Statements --
    ---------------------------------
 
-   --  SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT}
+   --  SEQUENCE_OF_STATEMENTS ::= STATEMENT {STATEMENT} {LABEL}
+   --  Note: the final label is an Ada2012 addition.
 
    --  STATEMENT ::=
    --    {LABEL} SIMPLE_STATEMENT | {LABEL} COMPOUND_STATEMENT
@@ -149,6 +150,12 @@ package body Ch5 is
       --  is required. It is initialized from the Sreq flag, and modified as
       --  statements are scanned (a statement turns it off, and a label turns
       --  it back on again since a statement must follow a label).
+      --  Note : this final requirement is lifted in Ada2012.
+
+      Statement_Seen : Boolean;
+      --  In Ada2012 a label can end a sequence of statements, but the sequence
+      --  cannot contain only labels. This flag is set whenever a label is
+      --  encountered, to enforce this rule at the end of a sequence.
 
       Declaration_Found : Boolean := False;
       --  This flag is set True if a declaration is encountered, so that the
@@ -222,8 +229,10 @@ package body Ch5 is
 
             if Ada_Version >= Ada_2012
               and then not Is_Empty_List (Statement_List)
-              and then (Nkind (Last (Statement_List)) = N_Label
-                          or else All_Pragmas)
+              and then
+                ((Nkind (Last (Statement_List)) = N_Label
+                   and then Statement_Seen)
+                or else All_Pragmas)
             then
                declare
                   Null_Stm : constant Node_Id :=
@@ -233,8 +242,6 @@ package body Ch5 is
                   Append_To (Statement_List, Null_Stm);
                end;
 
-            --  All pragmas is OK on
-
             --  If not Ada 2012, or not special case above, give error message
 
             else
@@ -249,6 +256,7 @@ package body Ch5 is
    begin
       Statement_List := New_List;
       Statement_Required := SS_Flags.Sreq;
+      Statement_Seen     := False;
 
       loop
          Ignore (Tok_Semicolon);
@@ -765,8 +773,15 @@ package body Ch5 is
                   Statement_Required := False;
 
                --  Label starting with << which must precede real statement
+               --  Note: in Ada2012, the label may end the sequence.
 
                when Tok_Less_Less =>
+                  if Present (Last (Statement_List))
+                    and then Nkind (Last (Statement_List)) /= N_Label
+                  then
+                     Statement_Seen := True;
+                  end if;
+
                   Append_To (Statement_List, P_Label);
                   Statement_Required := True;
 
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index c0744c41cbb..94d76be10a4 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -600,6 +600,7 @@ package Rtsfind is
      RE_Signature,                       -- Ada.Tags
      RE_SSD,                             -- Ada.Tags
      RE_TSD,                             -- Ada.Tags
+     RE_Type_Is_Abstract,                -- Ada.Tags
      RE_Type_Specific_Data,              -- Ada.Tags
      RE_Register_Interface_Offset,       -- Ada.Tags
      RE_Register_Tag,                    -- Ada.Tags
@@ -1770,6 +1771,7 @@ package Rtsfind is
      RE_Signature                        => Ada_Tags,
      RE_SSD                              => Ada_Tags,
      RE_TSD                              => Ada_Tags,
+     RE_Type_Is_Abstract                 => Ada_Tags,
      RE_Type_Specific_Data               => Ada_Tags,
      RE_Register_Interface_Offset        => Ada_Tags,
      RE_Register_Tag                     => Ada_Tags,
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 71730bead25..babdfde8588 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7950,10 +7950,11 @@ package body Sem_Attr is
                   --  been caught by the compilation of the generic unit.
 
                   --  Note that we relax this check in CodePeer mode for
-                  --  compatibility with legacy code.
-
-                  --  This seems an odd decision??? Why should codepeer mode
-                  --  have a different notion of legality from the compiler???
+                  --  compatibility with legacy code, since CodePeer is an
+                  --  Ada source code analyzer, not a strict compiler.
+                  --  ??? Note that a better approach would be to have a
+                  --  separate switch to relax this rule, and enable this
+                  --  switch in CodePeer mode.
 
                   elsif Attr_Id = Attribute_Access
                     and then not CodePeer_Mode
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5f258f23d68..7b8846f2e1c 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -475,12 +475,6 @@ package body Sem_Ch12 is
    --  of generic formals of a generic package declared with a box or with
    --  partial parametrization.
 
-   procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id);
-   --  If the generic unit comes from a different unit, indicate that the
-   --  unit that contains the instance depends on the body that contains
-   --  the generic body. Used to determine a more precise dependency graph
-   --  for use by CodePeer.
-
    procedure Set_Instance_Env
      (Gen_Unit : Entity_Id;
       Act_Unit : Entity_Id);
@@ -3237,8 +3231,7 @@ package body Sem_Ch12 is
                   or else Enclosing_Body_Present
                   or else Present (Corresponding_Body (Gen_Decl)))
                 and then (Is_In_Main_Unit (N)
-                           or else Might_Inline_Subp
-                           or else CodePeer_Mode)
+                           or else Might_Inline_Subp)
                 and then not Is_Actual_Pack
                 and then not Inline_Now
                 and then (Operating_Mode = Generate_Code
@@ -8609,8 +8602,6 @@ package body Sem_Ch12 is
          Gen_Body_Id := Corresponding_Body (Gen_Decl);
       end if;
 
-      Mark_Context (Act_Decl, Gen_Decl);
-
       --  Establish global variable for sloc adjustment and for error recovery
 
       Instantiation_Node := Inst_Node;
@@ -8893,7 +8884,6 @@ package body Sem_Ch12 is
 
       if Present (Gen_Body_Id) then
          Gen_Body := Unit_Declaration_Node (Gen_Body_Id);
-         Mark_Context (Inst_Node, Gen_Decl);
 
          if Nkind (Gen_Body) = N_Subprogram_Body_Stub then
 
@@ -10408,131 +10398,6 @@ package body Sem_Ch12 is
       end if;
    end Is_Generic_Formal;
 
-   ------------------
-   -- Mark_Context --
-   ------------------
-
-   procedure Mark_Context (Inst_Decl : Node_Id; Gen_Decl : Node_Id) is
-      Loc     : constant Source_Ptr := Sloc (Inst_Decl);
-      Inst_CU : constant Unit_Number_Type := Get_Code_Unit (Inst_Decl);
-
-      --  Note that we use Get_Code_Unit to determine the position of the
-      --  instantiation, because it may itself appear within another instance
-      --  and we need to mark the context of the enclosing unit, not that of
-      --  the unit that contains the generic.
-
-      Gen_CU  : constant Unit_Number_Type := Get_Source_Unit (Gen_Decl);
-      Inst    : Entity_Id;
-      Clause  : Node_Id;
-      Scop    : Entity_Id;
-
-      procedure Add_Implicit_With (CU : Unit_Number_Type);
-      --  If a generic is instantiated in the direct or indirect context of
-      --  the current unit, but there is no with_clause for it in the current
-      --  context, add a with_clause for it to indicate that the body of the
-      --  generic should be examined before the current unit.
-
-      procedure Add_Implicit_With (CU : Unit_Number_Type) is
-         Withn : constant Node_Id :=
-           Make_With_Clause (Loc,
-              Name => New_Occurrence_Of (Cunit_Entity (CU), Loc));
-      begin
-         Set_Implicit_With (Withn);
-         Set_Library_Unit (Withn, Cunit (CU));
-         Set_Withed_Body (Withn, Cunit (CU));
-         Prepend (Withn, Context_Items (Cunit (Inst_CU)));
-      end Add_Implicit_With;
-
-   begin
-      --  This is only relevant when compiling for CodePeer. In what follows,
-      --  C is the current unit containing the instance body, and G is the
-      --  generic unit in that instance.
-
-      if not CodePeer_Mode then
-         return;
-      end if;
-
-      --  Nothing to do if G is local.
-
-      if Inst_CU = Gen_CU then
-         return;
-      end if;
-
-      --  If G is itself  declared within an instance, indicate that the
-      --  generic body of that instance is also needed by C. This must be
-      --  done recursively.
-
-      Scop := Scope (Defining_Entity (Gen_Decl));
-
-      while Is_Generic_Instance (Scop)
-        and then Ekind (Scop) = E_Package
-      loop
-         Mark_Context
-           (Inst_Decl,
-            Unit_Declaration_Node
-              (Generic_Parent
-                 (Specification (Unit_Declaration_Node (Scop)))));
-         Scop := Scope (Scop);
-      end loop;
-
-      --  Add references to other generic units in the context of G, because
-      --  they may be instantiated within G, and their bodies needed by C.
-
-      Clause := First (Context_Items (Cunit (Gen_CU)));
-
-      while Present (Clause) loop
-         if Nkind (Clause) = N_With_Clause
-           and then
-             Nkind (Unit (Library_Unit (Clause)))
-               = N_Generic_Package_Declaration
-         then
-            Add_Implicit_With (Get_Source_Unit (Library_Unit (Clause)));
-         end if;
-
-         Next (Clause);
-      end loop;
-
-      --  Now indicate that the body of G is needed by C
-
-      Clause := First (Context_Items (Cunit (Inst_CU)));
-      while Present (Clause) loop
-         if Nkind (Clause) = N_With_Clause
-           and then  Library_Unit (Clause) = Cunit (Gen_CU)
-         then
-            Set_Withed_Body (Clause, Cunit (Gen_CU));
-            return;
-         end if;
-
-         Next (Clause);
-      end loop;
-
-      --  If the with-clause for G is not in the context of C, it may appear in
-      --  some ancestor of C.
-
-      Inst := Cunit_Entity (Inst_CU);
-      while Is_Child_Unit (Inst) loop
-         Inst := Scope (Inst);
-
-         Clause :=
-           First (Context_Items (Parent (Unit_Declaration_Node (Inst))));
-         while Present (Clause) loop
-            if Nkind (Clause) = N_With_Clause
-              and then Library_Unit (Clause) = Cunit (Gen_CU)
-            then
-               Set_Withed_Body (Clause, Cunit (Gen_CU));
-               return;
-            end if;
-
-            Next (Clause);
-         end loop;
-      end loop;
-
-      --  If not found, G comes from an instance elsewhere in the context. Make
-      --  the dependence explicit in the context of C.
-
-      Add_Implicit_With (Gen_CU);
-   end Mark_Context;
-
    ---------------------
    -- Is_In_Main_Unit --
    ---------------------