The new parameter makes it possible, while processing aggregate projects,
to stop the processing as soon as an error is found in one of the
aggregated projects.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-08-03 Emmanuel Briot <br...@adacore.com>
* prj-part.adb, prj-part.ads, prj-makr.adb, prj-pars.adb, prj-conf.adb,
prj-env.adb (Prj.Part.Parse): change parameter Always_Errout_Finalize
to Errout_Handling.
Index: prj-part.adb
===================================================================
--- prj-part.adb (revision 177243)
+++ prj-part.adb (working copy)
@@ -443,7 +443,7 @@
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String;
- Always_Errout_Finalize : Boolean;
+ Errout_Handling : Errout_Mode := Always_Finalize;
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False;
Current_Directory : String := "";
@@ -477,7 +477,10 @@
Path => Path_Name_Id);
Free (Real_Project_File_Name);
- Prj.Err.Initialize;
+ if Errout_Handling /= Never_Finalize then
+ Prj.Err.Initialize;
+ end if;
+
Prj.Err.Scanner.Set_Comment_As_Token (Store_Comments);
Prj.Err.Scanner.Set_End_Of_Line_As_Token (Store_Comments);
@@ -607,14 +610,23 @@
Project := Empty_Node;
end if;
- if No (Project) or else Always_Errout_Finalize then
- Prj.Err.Finalize;
+ case Errout_Handling is
+ when Always_Finalize =>
+ Prj.Err.Finalize;
- -- Reinitialize to avoid duplicate warnings later on
+ -- Reinitialize to avoid duplicate warnings later on
+ Prj.Err.Initialize;
- Prj.Err.Initialize;
- end if;
+ when Finalize_If_Error =>
+ if No (Project) then
+ Prj.Err.Finalize;
+ Prj.Err.Initialize;
+ end if;
+ when Never_Finalize =>
+ null;
+ end case;
+
exception
when X : others =>
Index: prj-part.ads
===================================================================
--- prj-part.ads (revision 177241)
+++ prj-part.ads (working copy)
@@ -29,11 +29,19 @@
package Prj.Part is
+ type Errout_Mode is
+ (Always_Finalize,
+ Finalize_If_Error,
+ Never_Finalize);
+ -- Whether Parse should call Errout.Finalize (which prints the error
+ -- messages on stdout). When Never_Finalize is used, Errout is not reset
+ -- either at the beginning of Parse.
+
procedure Parse
(In_Tree : Project_Node_Tree_Ref;
Project : out Project_Node_Id;
Project_File_Name : String;
- Always_Errout_Finalize : Boolean;
+ Errout_Handling : Errout_Mode := Always_Finalize;
Packages_To_Check : String_List_Access := All_Packages;
Store_Comments : Boolean := False;
Current_Directory : String := "";
Index: prj-makr.adb
===================================================================
--- prj-makr.adb (revision 177241)
+++ prj-makr.adb (working copy)
@@ -863,7 +863,7 @@
(In_Tree => Tree,
Project => Project_Node,
Project_File_Name => Output_Name.all,
- Always_Errout_Finalize => False,
+ Errout_Handling => Part.Finalize_If_Error,
Store_Comments => True,
Is_Config_File => False,
Flags => Flags,
Index: prj-pars.adb
===================================================================
--- prj-pars.adb (revision 177241)
+++ prj-pars.adb (working copy)
@@ -72,7 +72,7 @@
(In_Tree => Project_Node_Tree,
Project => Project_Node,
Project_File_Name => Project_File_Name,
- Always_Errout_Finalize => False,
+ Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Dir,
Flags => Flags,
Index: prj-conf.adb
===================================================================
--- prj-conf.adb (revision 177241)
+++ prj-conf.adb (working copy)
@@ -1119,7 +1119,7 @@
(In_Tree => Project_Node_Tree,
Project => Config_Project_Node,
Project_File_Name => Config_File_Path.all,
- Always_Errout_Finalize => False,
+ Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => True,
@@ -1212,7 +1212,7 @@
(In_Tree => Project_Node_Tree,
Project => User_Project_Node,
Project_File_Name => Project_File_Name,
- Always_Errout_Finalize => False,
+ Errout_Handling => Prj.Part.Finalize_If_Error,
Packages_To_Check => Packages_To_Check,
Current_Directory => Current_Directory,
Is_Config_File => False,
