[multiple changes]

2011-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Bad_Attribute_For_Predicate): flag illegal use of
	attribute only if prefix type is scalar.

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* make.adb, makeutl.adb, prj-env.adb (Check_Mains): put back support
	in gnatmake for specifying mains on the command line that do not belong
	to the main project. These mains must currently all belong to the same
	project, though.
	(Ultimate_Extension_Of): removed, since duplicated
	Ultimate_Extending_Project.

From-SVN: r177367

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 62e4eaa7d7e8bd25b6e3b87d3ec624f40e3a3693..f0256d7d1bda5a222b29cd3bc489042ba40d09f8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2011-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_attr.adb (Bad_Attribute_For_Predicate): flag illegal use of
+       attribute only if prefix type is scalar.
+
+2011-08-04  Emmanuel Briot  <briot@adacore.com>
+
+       * make.adb, makeutl.adb, prj-env.adb (Check_Mains): put back support
+       in gnatmake for specifying mains on the command line that do not belong
+       to the main project. These mains must currently all belong to the same
+       project, though.
+       (Ultimate_Extension_Of): removed, since duplicated
+       Ultimate_Extending_Project.
+
 2011-08-04  Arnaud Charlet  <charlet@adacore.com>
 
        * make.adb (Do_Codepeer_Globalize_Step): Removed. Use CodePeer_Mode

diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index a86846b7d4e093925bdcb2502ec2945c49c422fc..4bbb61a70f719fc84c2966fe3f8625f1571b4c07 100644 (file)
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -5673,6 +5673,9 @@ package body Make is
       -----------------
 
       procedure Check_Mains is
+         Real_Main_Project : Project_Id := No_Project;
+         Info : Main_Info;
+         Proj : Project_Id;
       begin
          if Mains.Number_Of_Mains (Project_Tree) = 0
            and then not Unique_Compile
@@ -5682,6 +5685,38 @@ package body Make is
 
          Mains.Complete_Mains
            (Root_Environment.Flags, Main_Project, Project_Tree);
+
+         --  If we have multiple mains on the command line, they need not
+         --  belong to the root project, but they must all belong to the same
+         --  project.
+         if not Unique_Compile then
+            Mains.Reset;
+            loop
+               Info := Mains.Next_Main;
+               exit when Info = No_Main_Info;
+
+               Debug_Output ("MANU Got main: ", Name_Id (Info.File));
+               Debug_Output ("MANU    in project: ", Info.Project.Name);
+
+               Proj := Ultimate_Extending_Project_Of (Info.Project);
+
+               if Real_Main_Project = No_Project then
+                  Real_Main_Project := Proj;
+               elsif Real_Main_Project /= Proj then
+                  Make_Failed
+                    ("""" & Get_Name_String (Info.File) &
+                     """ is not a source of project " &
+                     Get_Name_String (Real_Main_Project.Name));
+               end if;
+            end loop;
+
+            if Real_Main_Project /= No_Project then
+               Main_Project := Real_Main_Project;
+            end if;
+
+            Debug_Output ("After checking mains, main project is",
+                          Main_Project.Name);
+         end if;
       end Check_Mains;
 
    --  Start of processing for Gnatmake

diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 57853016d75eed2ae72045e35e01e697a6e20a8c..f9d4d728ed8460f7bd4243dc662741c776f2cbe1 100644 (file)
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -1442,9 +1442,10 @@ package body Makeutl is
 
                   begin
                      if Base /= Main then
+                        Is_Absolute := True;
+
                         if Is_Absolute_Path (Main) then
                            Main_Id := Create_Name (Base);
-                           Is_Absolute := True;
                         else
                            declare
                               Absolute : constant String :=
@@ -1545,7 +1546,7 @@ package body Makeutl is
                            Debug_Output
                              ("found main in project", Source.Project.Name);
                            Names.Table (J).File    := Source.File;
-                           Names.Table (J).Project := File.Project;
+                           Names.Table (J).Project := Source.Project;
 
                            if Names.Table (J).Tree = null then
                               Names.Table (J).Tree := File.Tree;

diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 100e178305b87a0dae7a85e2fcf08ef11583a830..15a443698fa3f31d6975ca19a7fa6d1ab8fdbaa1 100644 (file)
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -105,11 +105,6 @@ package body Prj.Env is
    procedure Set_Path_File_Var (Name : String; Value : String);
    --  Call Setenv, after calling To_Host_File_Spec
 
-   function Ultimate_Extension_Of
-     (Project : Project_Id) return Project_Id;
-   --  Return a project that is either Project or an extended ancestor of
-   --  Project that itself is not extended.
-
    ----------------------
    -- Ada_Include_Path --
    ----------------------
@@ -1345,8 +1340,8 @@ package body Prj.Env is
                               (Unit.File_Names (Spec).Path.Name) =
                             Original_Name))
             then
-               Project := Ultimate_Extension_Of
-                          (Project => Unit.File_Names (Spec).Project);
+               Project := Ultimate_Extending_Project_Of
+                          (Unit.File_Names (Spec).Project);
                Path := Unit.File_Names (Spec).Path.Display_Name;
 
                if Current_Verbosity > Default then
@@ -1367,8 +1362,8 @@ package body Prj.Env is
                             (Unit.File_Names (Impl).Path.Name) =
                             Original_Name))
             then
-               Project := Ultimate_Extension_Of
-                            (Project => Unit.File_Names (Impl).Project);
+               Project := Ultimate_Extending_Project_Of
+                            (Unit.File_Names (Impl).Project);
                Path := Unit.File_Names (Impl).Path.Display_Name;
 
                if Current_Verbosity > Default then
@@ -1556,15 +1551,7 @@ package body Prj.Env is
          Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
       end loop;
 
-      --  Get the ultimate extending project
-
-      if Result /= No_Project then
-         while Result.Extended_By /= No_Project loop
-            Result := Result.Extended_By;
-         end loop;
-      end if;
-
-      return Result;
+      return Ultimate_Extending_Project_Of (Result);
    end Project_Of;
 
    -------------------
@@ -1805,24 +1792,6 @@ package body Prj.Env is
       end if;
    end Set_Path_File_Var;
 
-   ---------------------------
-   -- Ultimate_Extension_Of --
-   ---------------------------
-
-   function Ultimate_Extension_Of
-     (Project : Project_Id) return Project_Id
-   is
-      Result : Project_Id;
-
-   begin
-      Result := Project;
-      while Result.Extended_By /= No_Project loop
-         Result := Result.Extended_By;
-      end loop;
-
-      return Result;
-   end Ultimate_Extension_Of;
-
    ---------------------
    -- Add_Directories --
    ---------------------

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7e77eb5bd8afdb181b9846dc0a0ae1c0fa21e13a..e7dd01ad0882a8a2f6e118a644acc892cf9f170e 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -217,6 +217,8 @@ package body Sem_Attr is
       --  actual, then the message is a warning, and we generate code to raise
       --  program error with an appropriate reason. No error message is given
       --  for internally generated uses of the attributes.
+      --  The legality rule only applies to scalar types, even though the
+      --  current AI mentions all subtypes.
 
       procedure Check_Array_Or_Scalar_Type;
       --  Common procedure used by First, Last, Range attribute to check
@@ -840,7 +842,9 @@ package body Sem_Attr is
 
       procedure Bad_Attribute_For_Predicate is
       begin
-         if Comes_From_Source (N) then
+         if Is_Scalar_Type (P_Type)
+           and then  Comes_From_Source (N)
+         then
             Error_Msg_Name_1 := Aname;
             Bad_Predicated_Subtype_Use
               ("type& has predicates, attribute % not allowed", N, P_Type);