[multiple changes]

2010-06-18  Pascal Obry  <obry@adacore.com>

	* make.adb, prj-nmsc.adb: Fix source filenames casing in debug output.

2010-06-18  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global
	configuration pragmas file and, if -U is not used, for a local one.

2010-06-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_Eliminated): Use full information on entity name
	when it is given in the pragma by a selected component.
	(Check_For_Eliminated_Subprogram): Do no emit error if within a
	instance body that is itself within a generic unit.
	* sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is
	eliminated, mark as well the anonymous subprogram that is its alias
	and appears within the wrapper package.

From-SVN: r160986

6 files changed, 184 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f177911..27f345a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2010-06-18  Pascal Obry  <obry@adacore.com>
+
+	* make.adb, prj-nmsc.adb: Fix source filenames casing in debug output.
+
+2010-06-18  Vincent Celier  <celier@adacore.com>
+
+	* gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global
+	configuration pragmas file and, if -U is not used, for a local one.
+
+2010-06-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_elim.adb (Check_Eliminated): Use full information on entity name
+	when it is given in the pragma by a selected component.
+	(Check_For_Eliminated_Subprogram): Do no emit error if within a
+	instance body that is itself within a generic unit.
+	* sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is
+	eliminated, mark as well the anonymous subprogram that is its alias
+	and appears within the wrapper package.
+
 2010-06-18  Bob Duff  <duff@adacore.com>
 
 	* g-pehage.ads, g-pehage.adb (Produce): Clean up some of the code.
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 57371aa..793c6c9 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/gcc/ada/gnatcmd.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-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- --
@@ -122,6 +122,7 @@ procedure GNATCmd is
 
    Naming_String      : constant SA := new String'("naming");
    Binder_String      : constant SA := new String'("binder");
+   Builder_String     : constant SA := new String'("builder");
    Compiler_String    : constant SA := new String'("compiler");
    Check_String       : constant SA := new String'("check");
    Synchronize_String : constant SA := new String'("synchronize");
@@ -139,7 +140,8 @@ procedure GNATCmd is
      new String_List'((Naming_String, Binder_String));
 
    Packages_To_Check_By_Check : constant String_List_Access :=
-     new String_List'((Naming_String, Check_String, Compiler_String));
+     new String_List'
+       ((Naming_String, Builder_String, Check_String, Compiler_String));
 
    Packages_To_Check_By_Sync : constant String_List_Access :=
      new String_List'((Naming_String, Synchronize_String, Compiler_String));
@@ -363,7 +365,7 @@ procedure GNATCmd is
 
       if Add_Sources then
 
-         --  For gnatcheck, gnatpp and gnatmetric , create a temporary file
+         --  For gnatcheck, gnatpp and gnatmetric, create a temporary file
          --  and put the list of sources in it.
 
          if The_Command = Check  or else
@@ -2198,6 +2200,87 @@ begin
                   Add_To_Carg_Switches
                     (new String'("-gnatem=" & Get_Name_String (M_File)));
                end if;
+
+               --  For gnatcheck, also indicate a global configuration pragmas
+               --  file and, if -U is not used, a local one.
+
+               if The_Command = Check then
+                  declare
+                     Pkg  : constant Prj.Package_Id :=
+                       Prj.Util.Value_Of
+                         (Name        => Name_Builder,
+                          In_Packages => Project.Decl.Packages,
+                          In_Tree     => Project_Tree);
+                     Variable : Variable_Value :=
+                       Prj.Util.Value_Of
+                         (Name                    => No_Name,
+                          Attribute_Or_Array_Name =>
+                            Name_Global_Configuration_Pragmas,
+                          In_Package              => Pkg,
+                          In_Tree                 => Project_Tree);
+
+                  begin
+                     if (Variable = Nil_Variable_Value or else
+                         Length_Of_Name (Variable.Value) = 0)
+                         and then Pkg /= No_Package
+                     then
+                        Variable :=
+                          Prj.Util.Value_Of
+                         (Name                    => Name_Ada,
+                          Attribute_Or_Array_Name => Name_Global_Config_File,
+                          In_Package              => Pkg,
+                          In_Tree                 => Project_Tree);
+                     end if;
+
+                     if Variable /= Nil_Variable_Value and then
+                       Length_Of_Name (Variable.Value) /= 0
+                     then
+                        Add_To_Carg_Switches
+                          (new String'
+                             ("-gnatec=" & Get_Name_String (Variable.Value)));
+                     end if;
+                  end;
+
+                  if not All_Projects then
+                     declare
+                        Pkg      : constant Prj.Package_Id :=
+                          Prj.Util.Value_Of
+                            (Name        => Name_Compiler,
+                             In_Packages => Project.Decl.Packages,
+                             In_Tree     => Project_Tree);
+                        Variable : Variable_Value :=
+                          Prj.Util.Value_Of
+                            (Name                    => No_Name,
+                             Attribute_Or_Array_Name =>
+                               Name_Local_Configuration_Pragmas,
+                             In_Package              => Pkg,
+                             In_Tree                 => Project_Tree);
+
+                     begin
+                        if (Variable = Nil_Variable_Value or else
+                              Length_Of_Name (Variable.Value) = 0)
+                          and then Pkg /= No_Package
+                        then
+                           Variable :=
+                             Prj.Util.Value_Of
+                               (Name                    => Name_Ada,
+                                Attribute_Or_Array_Name =>
+                                  Name_Local_Config_File,
+                                In_Package              => Pkg,
+                                In_Tree                 => Project_Tree);
+                        end if;
+
+                        if Variable /= Nil_Variable_Value and then
+                          Length_Of_Name (Variable.Value) /= 0
+                        then
+                           Add_To_Carg_Switches
+                             (new String'
+                                ("-gnatec=" &
+                                 Get_Name_String (Variable.Value)));
+                        end if;
+                     end;
+                  end if;
+               end if;
             end;
          end if;
 
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index 3af872f..bd67136 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -1395,7 +1395,7 @@ package body Make is
 
       if Project_Of_Current_Object_Directory /= Project then
          Project_Of_Current_Object_Directory := Project;
-         Object_Directory := Project.Object_Directory.Name;
+         Object_Directory := Project.Object_Directory.Display_Name;
 
          --  Set the working directory to the object directory of the actual
          --  project.
@@ -6078,7 +6078,7 @@ package body Make is
                exception
                   when others =>
 
-                     --  Delete the temporary mapping file, if one was created.
+                     --  Delete the temporary mapping file, if one was created
 
                      if Mapping_Path /= No_Path then
                         Delete_Temporary_File (Project_Tree, Mapping_Path);
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 0e8c041..df0cf82 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -703,7 +703,7 @@ package body Prj.Nmsc is
 
       if Current_Verbosity = High then
          Write_Str ("Adding source File: ");
-         Write_Str (Get_Name_String (File_Name));
+         Write_Str (Get_Name_String (Display_File));
 
          if Index /= 0 then
             Write_Str (" at" & Index'Img);
@@ -813,8 +813,8 @@ package body Prj.Nmsc is
    -----------
 
    procedure Check
-     (Project     : Project_Id;
-      Data        : in out Tree_Processing_Data)
+     (Project : Project_Id;
+      Data    : in out Tree_Processing_Data)
    is
       Specs     : Array_Element_Id;
       Bodies    : Array_Element_Id;
@@ -4883,7 +4883,7 @@ package body Prj.Nmsc is
          if not Removed and then List = Nil_String then
             if Current_Verbosity = High then
                Write_Str  ("   Adding Source Dir=");
-               Write_Line (Get_Name_String (Path_Id));
+               Write_Line (Get_Name_String (Display_Path_Id));
             end if;
 
             String_Element_Table.Increment_Last (Data.Tree.String_Elements);
@@ -6845,7 +6845,9 @@ package body Prj.Nmsc is
 
                begin
                   if Current_Verbosity = High then
-                     Write_Attr ("Source_Dir", Source_Directory);
+                     Write_Attr
+                       ("Source_Dir",
+                        Source_Directory (Source_Directory'First .. Dir_Last));
                      Write_Line (Num_Nod.Number'Img);
                   end if;
 
@@ -7382,7 +7384,7 @@ package body Prj.Nmsc is
       while Current /= Nil_String loop
          Element := In_Tree.String_Elements.Table (Current);
          Write_Str  ("   ");
-         Write_Line (Get_Name_String (Element.Value));
+         Write_Line (Get_Name_String (Element.Display_Value));
          Current := Element.Next;
       end loop;
 
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 4c98f39..cfb08c8 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4005,11 +4005,14 @@ package body Sem_Ch12 is
          --  If the instance is a child unit, mark the Id accordingly. Mark
          --  the anonymous entity as well, which is the real subprogram and
          --  which is used when the instance appears in a context clause.
+         --  Similarly, propagate the Is_Eliminated flag to handle properly
+         --  nested eliminated subprograms.
 
          Set_Is_Child_Unit (Act_Decl_Id, Is_Child_Unit (Defining_Entity (N)));
          Set_Is_Child_Unit (Anon_Id, Is_Child_Unit (Defining_Entity (N)));
          New_Overloaded_Entity (Act_Decl_Id);
          Check_Eliminated  (Act_Decl_Id);
+         Set_Is_Eliminated (Anon_Id, Is_Eliminated (Act_Decl_Id));
 
          --  In compilation unit case, kill elaboration checks on the
          --  instantiation, since they are never needed -- the body is
diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb
index bb42159..9917b1f 100644
--- a/gcc/ada/sem_elim.adb
+++ b/gcc/ada/sem_elim.adb
@@ -29,6 +29,7 @@ with Errout;   use Errout;
 with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
+with Opt;      use Opt;
 with Sem;      use Sem;
 with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
@@ -287,7 +288,8 @@ package body Sem_Elim is
                goto Continue;
             end if;
 
-            --  Find enclosing unit
+            --  Find enclosing unit, and verify that its name and those of its
+            --  parents match.
 
             Scop := Cunit_Entity (Current_Sem_Unit);
 
@@ -329,9 +331,6 @@ package body Sem_Elim is
                end if;
 
                Scop := Scope (Scop);
-               while Ekind (Scop) = E_Block loop
-                  Scop := Scope (Scop);
-               end loop;
 
                if Scop /= Standard_Standard and then J = 1 then
                   goto Continue;
@@ -342,8 +341,60 @@ package body Sem_Elim is
                goto Continue;
             end if;
 
-            --  Check for case of given entity is a library level subprogram
-            --  and we have the single parameter Eliminate case, a match!
+            if Present (Elmt.Entity_Node)
+              and then Elmt.Entity_Scope /= null
+            then
+
+               --  Check that names of enclosing scopes match.
+               --  Skip blocks and wrapper package of subprogram instances,
+               --  which do not appear in the pragma.
+
+               Scop := Scope (E);
+
+               for J in reverse  Elmt.Entity_Scope'Range loop
+                  while Ekind (Scop) = E_Block
+                    or else
+                     (Ekind (Scop) = E_Package
+                       and then Is_Wrapper_Package (Scop))
+                  loop
+                     Scop := Scope (Scop);
+                  end loop;
+
+                  if Elmt.Entity_Scope (J) /= Chars (Scop) then
+                     if Ekind (Scop) /= E_Protected_Type
+                       or else Comes_From_Source (Scop)
+                     then
+                        goto Continue;
+
+                     --  For simple protected declarations, retrieve the source
+                     --  name of the object, which appeared in the Eliminate
+                     --  pragma.
+
+                     else
+                        declare
+                           Decl : constant Node_Id :=
+                             Original_Node (Parent (Scop));
+
+                        begin
+                           if Elmt.Entity_Scope (J) /=
+                             Chars (Defining_Identifier (Decl))
+                           then
+                              if J > 0 then
+                                 null;
+                              end if;
+                              goto Continue;
+                           end if;
+                        end;
+                     end if;
+
+                  end if;
+
+                  Scop := Scope (Scop);
+               end loop;
+            end if;
+
+            --  If given entity is a library level subprogram and pragma had a
+            --  single parameter, a match!
 
             if Is_Compilation_Unit (E)
               and then Is_Subprogram (E)
@@ -672,7 +723,15 @@ package body Sem_Elim is
             Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp);
          end loop;
 
-         Eliminate_Error_Msg (N, Ultimate_Subp);
+         --  Emit error, unless we are within an instance body and
+         --  the expander is disabled, which indicates an instance
+         --  within an enclosing generic.
+
+         if In_Instance_Body and then not Expander_Active then
+            null;
+         else
+            Eliminate_Error_Msg (N, Ultimate_Subp);
+         end if;
       end if;
    end Check_For_Eliminated_Subprogram;