Patchwork [Ada] New project attribute Ignore_Source_Sub_Dirs

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 18, 2010, 10:04 a.m.
Message ID <20101018100400.GA26839@adacore.com>
Download mbox | patch
Permalink /patch/68160/
State New
Headers show

Comments

Arnaud Charlet - Oct. 18, 2010, 10:04 a.m.
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  <celier@adacore.com>

	* 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.

Patch

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 + $;