[multiple changes]

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications):
	Insert_Delayed_Pragma is now used for the case of Attach_Handler.
	* sem_prag.adb: Minor comment improvements.

2014-05-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Install_Body): When checking whether freezing of
	instantiation must be delayed, verify that the common enclosing
	subprogram to generic and instance is in fact an overloadable
	entity.

2014-05-21  Vincent Celier  <celier@adacore.com>

	* makeutl.adb (Mains.Complete_Mains.Do_Complete): Look for all
	mains with the same name and fail if there is more than one.
	* prj.ads, prj.adb (Find_All_Sources): New function

From-SVN: r210702

7 files changed, 229 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9e207fc..1ddf41c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,24 @@
 2014-05-21  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch13.adb (Analyze_Aspect_Specifications):
+	Insert_Delayed_Pragma is now used for the case of Attach_Handler.
+	* sem_prag.adb: Minor comment improvements.
+
+2014-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Install_Body): When checking whether freezing of
+	instantiation must be delayed, verify that the common enclosing
+	subprogram to generic and instance is in fact an overloadable
+	entity.
+
+2014-05-21  Vincent Celier  <celier@adacore.com>
+
+	* makeutl.adb (Mains.Complete_Mains.Do_Complete): Look for all
+	mains with the same name and fail if there is more than one.
+	* prj.ads, prj.adb (Find_All_Sources): New function
+
+2014-05-21  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch13.adb: Minor reformatting.
 	* lib-xref-spark_specific.adb, sem_util.adb: Minor reformatting.
 	* sem_prag.adb: Minor error message improvement.
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index a220cbe..d977251 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, 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- --
@@ -1732,7 +1732,7 @@ package body Makeutl is
                --  no need to process them in turn.
 
                J := Names.Last;
-               loop
+               Main_Loop : loop
                   declare
                      File        : Main_Info       := Names.Table (J);
                      Main_Id     : File_Name_Type  := File.File;
@@ -1798,16 +1798,53 @@ package body Makeutl is
                         --  search for the base name though, and if needed
                         --  check later that we found the correct file.
 
-                        Source := Find_Source
-                          (In_Tree          => File.Tree,
-                           Project          => File.Project,
-                           Base_Name        => Main_Id,
-                           Index            => File.Index,
-                           In_Imported_Only => True);
+                        declare
+                           Sources : constant Source_Ids :=
+                                       Find_All_Sources
+                                         (In_Tree          => File.Tree,
+                                          Project          => File.Project,
+                                          Base_Name        => Main_Id,
+                                          Index            => File.Index,
+                                          In_Imported_Only => True);
+
+                        begin
+                           if Is_Absolute then
+                              for J in Sources'Range loop
+                                 if File_Name_Type (Sources (J).Path.Name) =
+                                                                    File.File
+                                 then
+                                    Source := Sources (J);
+                                    exit;
+                                 end if;
+                              end loop;
+
+                           elsif Sources'Length > 1 then
+
+                              --  This is only allowed if the units are from
+                              --  the same multi-unit source file.
+
+                              Source := Sources (1);
+
+                              for J in 2 .. Sources'Last loop
+                                 if Sources (J).Path /= Source.Path
+                                   or else Sources (J).Index = Source.Index
+                                 then
+                                    Error_Msg_File_1 := Main_Id;
+                                    Prj.Err.Error_Msg
+                                      (Flags, "several main sources {",
+                                       No_Location, File.Project);
+                                    exit Main_Loop;
+                                 end if;
+                              end loop;
+
+                           elsif Sources'Length = 1 then
+                              Source := Sources (Sources'First);
+                           end if;
+                        end;
 
                         if Source = No_Source then
                            Source := Find_File_Add_Extension
-                             (File.Tree, Get_Name_String (Main_Id));
+                                       (File.Tree, Get_Name_String (Main_Id));
                         end if;
 
                         if Is_Absolute
@@ -1883,8 +1920,8 @@ package body Makeutl is
                   end;
 
                   J := J - 1;
-                  exit when J < Names.First;
-               end loop;
+                  exit Main_Loop when J < Names.First;
+               end loop Main_Loop;
             end if;
 
             if Total_Errors_Detected > 0 then
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 6a0a830..a50823e 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2014, 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- --
@@ -889,6 +889,104 @@ package body Prj is
       return Result;
    end Find_Source;
 
+   ----------------------
+   -- Find_All_Sources --
+   ----------------------
+
+   function Find_All_Sources
+     (In_Tree          : Project_Tree_Ref;
+      Project          : Project_Id;
+      In_Imported_Only : Boolean := False;
+      In_Extended_Only : Boolean := False;
+      Base_Name        : File_Name_Type;
+      Index            : Int := 0) return Source_Ids
+   is
+      Result : Source_Ids (1 .. 1_000);
+      Last   : Natural := 0;
+
+      type Empty_State is null record;
+      No_State : Empty_State;
+
+      procedure Look_For_Sources
+        (Proj  : Project_Id;
+         Tree  : Project_Tree_Ref;
+         State : in out Empty_State);
+      --  Look for Base_Name in the sources of Proj
+
+      ----------------------
+      -- Look_For_Sources --
+      ----------------------
+
+      procedure Look_For_Sources
+        (Proj  : Project_Id;
+         Tree  : Project_Tree_Ref;
+         State : in out Empty_State)
+      is
+         Iterator : Source_Iterator;
+         Src : Source_Id;
+
+      begin
+         State := No_State;
+
+         Iterator := For_Each_Source (In_Tree => Tree, Project => Proj);
+         while Element (Iterator) /= No_Source loop
+            if Element (Iterator).File = Base_Name
+              and then (Index = 0
+                        or else
+                          (Element (Iterator).Unit /= No_Unit_Index
+                           and then
+                           Element (Iterator).Index = Index))
+            then
+               Src := Element (Iterator);
+
+               --  If the source has been excluded, continue looking. We will
+               --  get the excluded source only if there is no other source
+               --  with the same base name that is not locally removed.
+
+               if not Element (Iterator).Locally_Removed then
+                  Last := Last + 1;
+                  Result (Last) := Src;
+               end if;
+            end if;
+
+            Next (Iterator);
+         end loop;
+      end Look_For_Sources;
+
+      procedure For_Imported_Projects is new For_Every_Project_Imported
+        (State => Empty_State, Action => Look_For_Sources);
+
+      Proj : Project_Id;
+
+   --  Start of processing for Find_All_Sources
+
+   begin
+      if In_Extended_Only then
+         Proj := Project;
+         while Proj /= No_Project loop
+            Look_For_Sources (Proj, In_Tree, No_State);
+            exit when Last > 0;
+            Proj := Proj.Extends;
+         end loop;
+
+      elsif In_Imported_Only then
+         Look_For_Sources (Project, In_Tree, No_State);
+
+         if Last = 0 then
+            For_Imported_Projects
+              (By                 => Project,
+               Tree               => In_Tree,
+               Include_Aggregated => False,
+               With_State         => No_State);
+         end if;
+
+      else
+         Look_For_Sources (No_Project, In_Tree, No_State);
+      end if;
+
+      return Result (1 .. Last);
+   end Find_All_Sources;
+
    ----------
    -- Hash --
    ----------
@@ -896,6 +994,10 @@ package body Prj is
    function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num);
    --  Used in implementation of other functions Hash below
 
+   ----------
+   -- Hash --
+   ----------
+
    function Hash (Name : File_Name_Type) return Header_Num is
    begin
       return Hash (Get_Name_String (Name));
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 519e874..d0af1a2 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2014, 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- --
@@ -1525,6 +1525,24 @@ package Prj is
    --  Else it searches in the whole tree.
    --  If Index is specified, this only search for a source with that index.
 
+   type Source_Ids is array (Positive range <>) of Source_Id;
+   No_Sources : constant Source_Ids := (1 .. 0 => No_Source);
+
+   function Find_All_Sources
+     (In_Tree          : Project_Tree_Ref;
+      Project          : Project_Id;
+      In_Imported_Only : Boolean := False;
+      In_Extended_Only : Boolean := False;
+      Base_Name        : File_Name_Type;
+      Index            : Int := 0) return Source_Ids;
+   --  Find all source files with the given name.
+   --  If In_Extended_Only is True, it will search in project and the project
+   --     it extends, but not in the imported projects.
+   --  Elsif In_Imported_Only is True, it will search in project and the
+   --     projects it imports, but not in the others or in aggregated projects.
+   --  Else it searches in the whole tree.
+   --  If Index is specified, this only search for sources with that index.
+
    -----------------------
    -- Project_Tree_Data --
    -----------------------
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5aa0904..c7d1669 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -3588,7 +3588,6 @@ package body Sem_Ch12 is
          Set_Instance_Env (Gen_Unit, Act_Decl_Id);
          Set_Defining_Unit_Name (Act_Spec, Act_Decl_Name);
          Set_Is_Generic_Instance (Act_Decl_Id);
-
          Set_Generic_Parent (Act_Spec, Gen_Unit);
 
          --  References to the generic in its own declaration or its body are
@@ -8171,8 +8170,8 @@ package body Sem_Ch12 is
 
       Must_Delay : Boolean;
 
-      function Enclosing_Subp (Id : Entity_Id) return Entity_Id;
-      --  Find subprogram (if any) that encloses instance and/or generic body
+      function In_Same_Enclosing_Subp return Boolean;
+      --  Check whether instance and generic body are within same subprogram.
 
       function True_Sloc (N : Node_Id) return Source_Ptr;
       --  If the instance is nested inside a generic unit, the Sloc of the
@@ -8182,23 +8181,39 @@ package body Sem_Ch12 is
       --  origin of a node by finding the maximum sloc of any ancestor node.
       --  Why is this not equivalent to Top_Level_Location ???
 
-      --------------------
-      -- Enclosing_Subp --
-      --------------------
+      ----------------------------
+      -- In_Same_Enclosing_Subp --
+      ----------------------------
 
-      function Enclosing_Subp (Id : Entity_Id) return Entity_Id is
+      function In_Same_Enclosing_Subp return Boolean is
          Scop : Entity_Id;
+         Subp : Entity_Id;
 
       begin
-         Scop := Scope (Id);
+         Scop := Scope (Act_Id);
          while Scop /= Standard_Standard
            and then not Is_Overloadable (Scop)
          loop
             Scop := Scope (Scop);
          end loop;
 
-         return Scop;
-      end Enclosing_Subp;
+         if Scop = Standard_Standard then
+            return False;
+         else
+            Subp := Scop;
+         end if;
+
+         Scop := Scope (Gen_Id);
+         while Scop /= Standard_Standard loop
+            if Scop = Subp then
+               return True;
+            end if;
+
+            Scop := Scope (Scop);
+         end loop;
+
+         return False;
+      end In_Same_Enclosing_Subp;
 
       ---------------
       -- True_Sloc --
@@ -8255,8 +8270,7 @@ package body Sem_Ch12 is
                                 and then True_Sloc (N) < Sloc (Orig_Body)))
           and then Is_In_Main_Unit (Gen_Unit)
           and then (Scope (Act_Id) = Scope (Gen_Id)
-                      or else
-                    Enclosing_Subp (Act_Id) = Enclosing_Subp (Gen_Id)));
+                      or else In_Same_Enclosing_Subp));
 
       --  If this is an early instantiation, the freeze node is placed after
       --  the generic body. Otherwise, if the generic appears in an instance,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8964bac611..bf42b0e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1161,7 +1161,8 @@ package body Sem_Ch13 is
       procedure Insert_Delayed_Pragma (Prag : Node_Id);
       --  Insert a postcondition-like pragma into the tree depending on the
       --  context. Prag must denote one of the following: Pre, Post, Depends,
-      --  Global or Contract_Cases.
+      --  Global or Contract_Cases. This procedure is also used for the case
+      --  of Attach_Handler which has similar requirements for placement.
 
       --------------------------------
       -- Decorate_Aspect_And_Pragma --
@@ -1463,7 +1464,7 @@ package body Sem_Ch13 is
 
             Check_Restriction_No_Specification_Of_Aspect (Aspect);
 
-            --  Analyze this aspect (actual analysis is delayed till later)
+            --  Mark aspect analyzed (actual analysis is delayed till later)
 
             Set_Analyzed (Aspect);
             Set_Entity (Aspect, E);
@@ -1678,6 +1679,12 @@ package body Sem_Ch13 is
                          Expression => Relocate_Node (Expr))),
                      Pragma_Name                  => Name_Attach_Handler);
 
+                  --  We need to insert this pragma into the tree to get proper
+                  --  processing and to look valid from a placement viewpoint.
+
+                  Insert_Delayed_Pragma (Aitem);
+                  goto Continue;
+
                --  Dynamic_Predicate, Predicate, Static_Predicate
 
                when Aspect_Dynamic_Predicate |
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 6764612..416eb04 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -4552,7 +4552,7 @@ package body Sem_Prag is
 
             --  For pragma case (as opposed to access case), check placement.
             --  We don't need to do that for aspects, because we have the
-            --  check that they are apply an appropriate procedure.
+            --  check that they aspect applies an appropriate procedure.
 
             if not From_Aspect_Specification (N)
               and then Parent (N) /= Protected_Definition (Parent (Proc_Scope))
@@ -6387,12 +6387,11 @@ package body Sem_Prag is
             Set_Treat_As_Volatile (E);
 
          else
-            Error_Pragma_Arg
-              ("inappropriate entity for pragma%", Arg1);
+            Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
          end if;
 
-         --  The following check are only relevant when SPARK_Mode is on as
-         --  those are not a standard Ada legality rule. Pragma Volatile can
+         --  The following check is only relevant when SPARK_Mode is on as
+         --  this is not a standard Ada legality rule. Pragma Volatile can
          --  only apply to a full type declaration or an object declaration
          --  (SPARK RM C.6(1)).