Commit 9515740f by Arnaud Charlet

[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
parent 92966893
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> 2011-08-04 Arnaud Charlet <charlet@adacore.com>
* make.adb (Do_Codepeer_Globalize_Step): Removed. Use CodePeer_Mode * make.adb (Do_Codepeer_Globalize_Step): Removed. Use CodePeer_Mode
......
...@@ -5673,6 +5673,9 @@ package body Make is ...@@ -5673,6 +5673,9 @@ package body Make is
----------------- -----------------
procedure Check_Mains is procedure Check_Mains is
Real_Main_Project : Project_Id := No_Project;
Info : Main_Info;
Proj : Project_Id;
begin begin
if Mains.Number_Of_Mains (Project_Tree) = 0 if Mains.Number_Of_Mains (Project_Tree) = 0
and then not Unique_Compile and then not Unique_Compile
...@@ -5682,6 +5685,38 @@ package body Make is ...@@ -5682,6 +5685,38 @@ package body Make is
Mains.Complete_Mains Mains.Complete_Mains
(Root_Environment.Flags, Main_Project, Project_Tree); (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; end Check_Mains;
-- Start of processing for Gnatmake -- Start of processing for Gnatmake
......
...@@ -1442,9 +1442,10 @@ package body Makeutl is ...@@ -1442,9 +1442,10 @@ package body Makeutl is
begin begin
if Base /= Main then if Base /= Main then
Is_Absolute := True;
if Is_Absolute_Path (Main) then if Is_Absolute_Path (Main) then
Main_Id := Create_Name (Base); Main_Id := Create_Name (Base);
Is_Absolute := True;
else else
declare declare
Absolute : constant String := Absolute : constant String :=
...@@ -1545,7 +1546,7 @@ package body Makeutl is ...@@ -1545,7 +1546,7 @@ package body Makeutl is
Debug_Output Debug_Output
("found main in project", Source.Project.Name); ("found main in project", Source.Project.Name);
Names.Table (J).File := Source.File; 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 if Names.Table (J).Tree = null then
Names.Table (J).Tree := File.Tree; Names.Table (J).Tree := File.Tree;
......
...@@ -105,11 +105,6 @@ package body Prj.Env is ...@@ -105,11 +105,6 @@ package body Prj.Env is
procedure Set_Path_File_Var (Name : String; Value : String); procedure Set_Path_File_Var (Name : String; Value : String);
-- Call Setenv, after calling To_Host_File_Spec -- 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 -- -- Ada_Include_Path --
---------------------- ----------------------
...@@ -1345,8 +1340,8 @@ package body Prj.Env is ...@@ -1345,8 +1340,8 @@ package body Prj.Env is
(Unit.File_Names (Spec).Path.Name) = (Unit.File_Names (Spec).Path.Name) =
Original_Name)) Original_Name))
then then
Project := Ultimate_Extension_Of Project := Ultimate_Extending_Project_Of
(Project => Unit.File_Names (Spec).Project); (Unit.File_Names (Spec).Project);
Path := Unit.File_Names (Spec).Path.Display_Name; Path := Unit.File_Names (Spec).Path.Display_Name;
if Current_Verbosity > Default then if Current_Verbosity > Default then
...@@ -1367,8 +1362,8 @@ package body Prj.Env is ...@@ -1367,8 +1362,8 @@ package body Prj.Env is
(Unit.File_Names (Impl).Path.Name) = (Unit.File_Names (Impl).Path.Name) =
Original_Name)) Original_Name))
then then
Project := Ultimate_Extension_Of Project := Ultimate_Extending_Project_Of
(Project => Unit.File_Names (Impl).Project); (Unit.File_Names (Impl).Project);
Path := Unit.File_Names (Impl).Path.Display_Name; Path := Unit.File_Names (Impl).Path.Display_Name;
if Current_Verbosity > Default then if Current_Verbosity > Default then
...@@ -1556,15 +1551,7 @@ package body Prj.Env is ...@@ -1556,15 +1551,7 @@ package body Prj.Env is
Unit := Units_Htable.Get_Next (In_Tree.Units_HT); Unit := Units_Htable.Get_Next (In_Tree.Units_HT);
end loop; end loop;
-- Get the ultimate extending project return Ultimate_Extending_Project_Of (Result);
if Result /= No_Project then
while Result.Extended_By /= No_Project loop
Result := Result.Extended_By;
end loop;
end if;
return Result;
end Project_Of; end Project_Of;
------------------- -------------------
...@@ -1805,24 +1792,6 @@ package body Prj.Env is ...@@ -1805,24 +1792,6 @@ package body Prj.Env is
end if; end if;
end Set_Path_File_Var; 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 -- -- Add_Directories --
--------------------- ---------------------
......
...@@ -217,6 +217,8 @@ package body Sem_Attr is ...@@ -217,6 +217,8 @@ package body Sem_Attr is
-- actual, then the message is a warning, and we generate code to raise -- actual, then the message is a warning, and we generate code to raise
-- program error with an appropriate reason. No error message is given -- program error with an appropriate reason. No error message is given
-- for internally generated uses of the attributes. -- 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; procedure Check_Array_Or_Scalar_Type;
-- Common procedure used by First, Last, Range attribute to check -- Common procedure used by First, Last, Range attribute to check
...@@ -840,7 +842,9 @@ package body Sem_Attr is ...@@ -840,7 +842,9 @@ package body Sem_Attr is
procedure Bad_Attribute_For_Predicate is procedure Bad_Attribute_For_Predicate is
begin 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; Error_Msg_Name_1 := Aname;
Bad_Predicated_Subtype_Use Bad_Predicated_Subtype_Use
("type& has predicates, attribute % not allowed", N, P_Type); ("type& has predicates, attribute % not allowed", N, P_Type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment