From patchwork Mon Oct 18 10:04:00 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 68160 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 1A1C7B70EB for ; Mon, 18 Oct 2010 21:04:11 +1100 (EST) Received: (qmail 27318 invoked by alias); 18 Oct 2010 10:04:10 -0000 Received: (qmail 27307 invoked by uid 22791); 18 Oct 2010 10:04:08 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, TW_PR, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 18 Oct 2010 10:04:03 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id C4F55CB0326; Mon, 18 Oct 2010 12:04:00 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 6zhyB-Aw6QHb; Mon, 18 Oct 2010 12:04:00 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id B1700CB02A5; Mon, 18 Oct 2010 12:04:00 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 8F78AD9BB4; Mon, 18 Oct 2010 12:04:00 +0200 (CEST) Date: Mon, 18 Oct 2010 12:04:00 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Celier Subject: [Ada] New project attribute Ignore_Source_Sub_Dirs Message-ID: <20101018100400.GA26839@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 A new project level attribute is introduced to suppress subtrees to be included in the source directories when using ".../**" in Source_Dirs. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-18 Vincent Celier * prj-attr.adb: New project level attribute Ignore_Source_Sub_Dirs. * prj-nmsc.adb (Expand_Subdirectory_Pattern): New string list parameter Ignore. (Recursive_Find_Dirs): Do not consider subdirectories listed in Ignore. (Get_Directories): Call Find_Source_Dirs with the string list indicated by attribute Ignore_Source_Sub_Dirs. * snames.ads-tmpl: New standard name Ignore_Source_Sub_Dirs. Index: prj-nmsc.adb =================================================================== --- prj-nmsc.adb (revision 165611) +++ prj-nmsc.adb (working copy) @@ -223,6 +223,7 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data; Patterns : String_List_Id; + Ignore : String_List_Id; Search_For : Search_Type; Resolve_Links : Boolean); -- Search the subdirectories of Project's directory for files or @@ -966,6 +967,7 @@ package body Prj.Nmsc is (Project => Project, Data => Data, Patterns => Project_Files.Values, + Ignore => Nil_String, Search_For => Search_Files, Resolve_Links => Opt.Follow_Links_For_Files); @@ -4950,6 +4952,12 @@ package body Prj.Nmsc is Util.Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree); + Ignore_Source_Sub_Dirs : constant Variable_Value := + Util.Value_Of + (Name_Ignore_Source_Sub_Dirs, + Project.Decl.Attributes, + Data.Tree); + Excluded_Source_Dirs : constant Variable_Value := Util.Value_Of (Name_Excluded_Source_Dirs, @@ -5259,6 +5267,7 @@ package body Prj.Nmsc is (Project => Project, Data => Data, Patterns => Source_Dirs.Values, + Ignore => Ignore_Source_Sub_Dirs.Values, Search_For => Search_Directories, Resolve_Links => Opt.Follow_Links_For_Dirs); @@ -5280,6 +5289,7 @@ package body Prj.Nmsc is (Project => Project, Data => Data, Patterns => Excluded_Source_Dirs.Values, + Ignore => Nil_String, Search_For => Search_Directories, Resolve_Links => Opt.Follow_Links_For_Dirs); end if; @@ -6745,6 +6755,7 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data; Patterns : String_List_Id; + Ignore : String_List_Id; Search_For : Search_Type; Resolve_Links : Boolean) is @@ -6878,17 +6889,42 @@ package body Prj.Nmsc is Resolve_Links => Resolve_Links) & Directory_Separator; Path2 : Path_Information; + OK : Boolean := True; begin if Is_Directory (Path_Name) then - Name_Len := 0; - Add_Str_To_Name_Buffer (Path_Name); - Path2.Display_Name := Name_Find; + if Ignore /= Nil_String then + declare + Dir_Name : String := Name (1 .. Last); + List : String_List_Id := Ignore; + begin + Canonical_Case_File_Name (Dir_Name); - Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); - Path2.Name := Name_Find; + while List /= Nil_String loop + Get_Name_String + (Data.Tree.String_Elements.Table + (List).Value); + Canonical_Case_File_Name + (Name_Buffer (1 .. Name_Len)); + OK := Name_Buffer (1 .. Name_Len) /= Dir_Name; + exit when not OK; + List := Data.Tree.String_Elements.Table + (List).Next; + end loop; + end; + end if; + + if OK then + Name_Len := 0; + Add_Str_To_Name_Buffer (Path_Name); + Path2.Display_Name := Name_Find; - Success := Recursive_Find_Dirs (Path2, Rank) or Success; + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + Path2.Name := Name_Find; + + Success := + Recursive_Find_Dirs (Path2, Rank) or Success; + end if; end if; end; end if; Index: prj-attr.adb =================================================================== --- prj-attr.adb (revision 165610) +++ prj-attr.adb (working copy) @@ -81,6 +81,7 @@ package body Prj.Attr is "LVsource_dirs#" & "Lainherit_source_path#" & "LVexcluded_source_dirs#" & + "LVignore_source_sub_dirs#" & -- Source files Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 165610) +++ snames.ads-tmpl (working copy) @@ -1089,6 +1089,7 @@ package Snames is Name_Gnatstub : constant Name_Id := N + $; Name_Gnu : constant Name_Id := N + $; Name_Ide : constant Name_Id := N + $; + Name_Ignore_Source_Sub_Dirs : constant Name_Id := N + $; Name_Implementation : constant Name_Id := N + $; Name_Implementation_Exceptions : constant Name_Id := N + $; Name_Implementation_Suffix : constant Name_Id := N + $;