* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177367
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
-----------------
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
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
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 :=
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;
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 --
----------------------
(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
(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
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;
-------------------
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 --
---------------------
-- 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
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);