Commit 3aee21ef by Arnaud Charlet

[multiple changes]

2010-06-23  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-nmsc.adb (Processing_Flags): New flag
	Missing_Source_Files.

2010-06-23  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb, exp_util.adb: Minor reformatting.

From-SVN: r161249
parent 5b599df4
2010-06-23 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Processing_Flags): New flag
Missing_Source_Files.
2010-06-23 Robert Dewar <dewar@adacore.com>
* exp_ch3.adb, exp_util.adb: Minor reformatting.
2010-06-23 Jose Ruiz <ruiz@adacore.com> 2010-06-23 Jose Ruiz <ruiz@adacore.com>
* a-reatim.adb, a-retide.adb: Move the initialization of the tasking * a-reatim.adb, a-retide.adb: Move the initialization of the tasking
......
...@@ -5927,8 +5927,8 @@ package body Exp_Ch3 is ...@@ -5927,8 +5927,8 @@ package body Exp_Ch3 is
and then Has_Discriminants (Def_Id) and then Has_Discriminants (Def_Id)
then then
declare declare
Ctyp : constant Entity_Id := Ctyp : constant Entity_Id :=
Corresponding_Concurrent_Type (Def_Id); Corresponding_Concurrent_Type (Def_Id);
Conc_Discr : Entity_Id; Conc_Discr : Entity_Id;
Rec_Discr : Entity_Id; Rec_Discr : Entity_Id;
Temp : Entity_Id; Temp : Entity_Id;
...@@ -5936,7 +5936,6 @@ package body Exp_Ch3 is ...@@ -5936,7 +5936,6 @@ package body Exp_Ch3 is
begin begin
Conc_Discr := First_Discriminant (Ctyp); Conc_Discr := First_Discriminant (Ctyp);
Rec_Discr := First_Discriminant (Def_Id); Rec_Discr := First_Discriminant (Def_Id);
while Present (Conc_Discr) loop while Present (Conc_Discr) loop
Temp := Discriminal (Conc_Discr); Temp := Discriminal (Conc_Discr);
Set_Discriminal (Conc_Discr, Discriminal (Rec_Discr)); Set_Discriminal (Conc_Discr, Discriminal (Rec_Discr));
...@@ -7821,12 +7820,11 @@ package body Exp_Ch3 is ...@@ -7821,12 +7820,11 @@ package body Exp_Ch3 is
-- If a primitive is encountered that renames the predefined -- If a primitive is encountered that renames the predefined
-- equality operator before reaching any explicit equality -- equality operator before reaching any explicit equality
-- primitive, then we still need to create a predefined -- primitive, then we still need to create a predefined equality
-- equality function, because calls to it can occur via -- function, because calls to it can occur via the renaming. A new
-- the renaming. A new name is created for the equality -- name is created for the equality to avoid conflicting with any
-- to avoid conflicting with any user-defined equality. -- user-defined equality. (Note that this doesn't account for
-- (Note that this doesn't account for renamings of -- renamings of equality nested within subpackages???)
-- equality nested within subpackages???)
if Is_Predefined_Eq_Renaming (Node (Prim)) then if Is_Predefined_Eq_Renaming (Node (Prim)) then
Eq_Name := New_External_Name (Chars (Node (Prim)), 'E'); Eq_Name := New_External_Name (Chars (Node (Prim)), 'E');
......
...@@ -305,11 +305,9 @@ package body Exp_Util is ...@@ -305,11 +305,9 @@ package body Exp_Util is
else else
if No (Actions (Fnode)) then if No (Actions (Fnode)) then
Set_Actions (Fnode, L); Set_Actions (Fnode, L);
else else
Append_List (L, Actions (Fnode)); Append_List (L, Actions (Fnode));
end if; end if;
end if; end if;
end Append_Freeze_Actions; end Append_Freeze_Actions;
......
...@@ -6537,19 +6537,40 @@ package body Prj.Nmsc is ...@@ -6537,19 +6537,40 @@ package body Prj.Nmsc is
if not NL.Found then if not NL.Found then
Err_Vars.Error_Msg_File_1 := NL.Name; Err_Vars.Error_Msg_File_1 := NL.Name;
if First_Error then case Data.Flags.Missing_Source_Files is
Error_Msg when Error =>
(Data.Flags, if First_Error then
"source file { not found", Error_Msg
NL.Location, Project.Project); (Data.Flags,
First_Error := False; "source file { not found",
NL.Location, Project.Project);
First_Error := False;
else else
Error_Msg Error_Msg
(Data.Flags, (Data.Flags,
"\source file { not found", "\source file { not found",
NL.Location, Project.Project); NL.Location, Project.Project);
end if; end if;
when Warning =>
if First_Error then
Error_Msg
(Data.Flags,
"?source file { not found",
NL.Location, Project.Project);
First_Error := False;
else
Error_Msg
(Data.Flags,
"?\source file { not found",
NL.Location, Project.Project);
end if;
when Silent =>
null;
end case;
end if; end if;
NL := Source_Names_Htable.Get_Next (Project.Source_Names); NL := Source_Names_Htable.Get_Next (Project.Source_Names);
......
...@@ -1230,7 +1230,8 @@ package body Prj is ...@@ -1230,7 +1230,8 @@ package body Prj is
Compiler_Driver_Mandatory : Boolean := False; Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True; Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error; Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error) Allow_Invalid_External : Error_Warning := Error;
Missing_Source_Files : Error_Warning := Error)
return Processing_Flags return Processing_Flags
is is
begin begin
...@@ -1242,7 +1243,8 @@ package body Prj is ...@@ -1242,7 +1243,8 @@ package body Prj is
Error_On_Unknown_Language => Error_On_Unknown_Language, Error_On_Unknown_Language => Error_On_Unknown_Language,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory, Compiler_Driver_Mandatory => Compiler_Driver_Mandatory,
Require_Obj_Dirs => Require_Obj_Dirs, Require_Obj_Dirs => Require_Obj_Dirs,
Allow_Invalid_External => Allow_Invalid_External); Allow_Invalid_External => Allow_Invalid_External,
Missing_Source_Files => Missing_Source_Files);
end Create_Flags; end Create_Flags;
------------ ------------
......
...@@ -1459,7 +1459,8 @@ package Prj is ...@@ -1459,7 +1459,8 @@ package Prj is
Compiler_Driver_Mandatory : Boolean := False; Compiler_Driver_Mandatory : Boolean := False;
Error_On_Unknown_Language : Boolean := True; Error_On_Unknown_Language : Boolean := True;
Require_Obj_Dirs : Error_Warning := Error; Require_Obj_Dirs : Error_Warning := Error;
Allow_Invalid_External : Error_Warning := Error) Allow_Invalid_External : Error_Warning := Error;
Missing_Source_Files : Error_Warning := Error)
return Processing_Flags; return Processing_Flags;
-- Function used to create Processing_Flags structure -- Function used to create Processing_Flags structure
-- --
...@@ -1492,6 +1493,10 @@ package Prj is ...@@ -1492,6 +1493,10 @@ package Prj is
-- If Allow_Invalid_External is Silent, then no error is reported when an -- If Allow_Invalid_External is Silent, then no error is reported when an
-- invalid value is used for an external variable (and it doesn't match its -- invalid value is used for an external variable (and it doesn't match its
-- type). Instead, the first possible value is used. -- type). Instead, the first possible value is used.
--
-- Missing_Source_Files indicates whether it is an error or a warning that
-- a source file mentioned in the Source_Files attributes is not actually
-- found in the source directories
Gprbuild_Flags : constant Processing_Flags; Gprbuild_Flags : constant Processing_Flags;
Gprclean_Flags : constant Processing_Flags; Gprclean_Flags : constant Processing_Flags;
...@@ -1521,6 +1526,10 @@ package Prj is ...@@ -1521,6 +1526,10 @@ package Prj is
-- another program running on the same machine has recreated it. -- another program running on the same machine has recreated it.
-- Does nothing if Debug.Debug_Flag_N is set -- Does nothing if Debug.Debug_Flag_N is set
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
-- normally forbidden for project names, there cannot be any name clash.
private private
All_Packages : constant String_List_Access := null; All_Packages : constant String_List_Access := null;
...@@ -1535,10 +1544,6 @@ private ...@@ -1535,10 +1544,6 @@ private
Location => No_Location, Location => No_Location,
Default => False); Default => False);
Virtual_Prefix : constant String := "v$";
-- The prefix for virtual extending projects. Because of the '$', which is
-- normally forbidden for project names, there cannot be any name clash.
type Source_Iterator is record type Source_Iterator is record
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
...@@ -1601,6 +1606,7 @@ private ...@@ -1601,6 +1606,7 @@ private
Error_On_Unknown_Language : Boolean; Error_On_Unknown_Language : Boolean;
Require_Obj_Dirs : Error_Warning; Require_Obj_Dirs : Error_Warning;
Allow_Invalid_External : Error_Warning; Allow_Invalid_External : Error_Warning;
Missing_Source_Files : Error_Warning;
end record; end record;
Gprbuild_Flags : constant Processing_Flags := Gprbuild_Flags : constant Processing_Flags :=
...@@ -1611,7 +1617,8 @@ private ...@@ -1611,7 +1617,8 @@ private
Compiler_Driver_Mandatory => True, Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True, Error_On_Unknown_Language => True,
Require_Obj_Dirs => Error, Require_Obj_Dirs => Error,
Allow_Invalid_External => Error); Allow_Invalid_External => Error,
Missing_Source_Files => Error);
Gprclean_Flags : constant Processing_Flags := Gprclean_Flags : constant Processing_Flags :=
(Report_Error => null, (Report_Error => null,
...@@ -1621,7 +1628,8 @@ private ...@@ -1621,7 +1628,8 @@ private
Compiler_Driver_Mandatory => True, Compiler_Driver_Mandatory => True,
Error_On_Unknown_Language => True, Error_On_Unknown_Language => True,
Require_Obj_Dirs => Warning, Require_Obj_Dirs => Warning,
Allow_Invalid_External => Error); Allow_Invalid_External => Error,
Missing_Source_Files => Warning);
Gnatmake_Flags : constant Processing_Flags := Gnatmake_Flags : constant Processing_Flags :=
(Report_Error => null, (Report_Error => null,
...@@ -1631,6 +1639,7 @@ private ...@@ -1631,6 +1639,7 @@ private
Compiler_Driver_Mandatory => False, Compiler_Driver_Mandatory => False,
Error_On_Unknown_Language => False, Error_On_Unknown_Language => False,
Require_Obj_Dirs => Error, Require_Obj_Dirs => Error,
Allow_Invalid_External => Error); Allow_Invalid_External => Error,
Missing_Source_Files => Error);
end Prj; end Prj;
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