From patchwork Wed Aug 3 09:22:04 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 108070 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id D6DCCB71E3 for ; Wed, 3 Aug 2011 19:22:39 +1000 (EST) Received: (qmail 32217 invoked by alias); 3 Aug 2011 09:22:35 -0000 Received: (qmail 32208 invoked by uid 22791); 3 Aug 2011 09:22:34 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL,BAYES_00,TW_PR X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 03 Aug 2011 09:22:05 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id EF4FF2BADEE; Wed, 3 Aug 2011 05:22:04 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 61GUCBmn4AZB; Wed, 3 Aug 2011 05:22:04 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id DBABF2BADE0; Wed, 3 Aug 2011 05:22:04 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id DD2CA3FEE8; Wed, 3 Aug 2011 05:22:04 -0400 (EDT) Date: Wed, 3 Aug 2011 05:22:04 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Emmanuel Briot Subject: [Ada] Change of profile for Prj.Part.Parse Message-ID: <20110803092204.GA9678@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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,