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>
* make.adb (Do_Codepeer_Globalize_Step): Removed. Use CodePeer_Mode
......
......@@ -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
......
......@@ -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;
......
......@@ -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 --
---------------------
......
......@@ -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);
......
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