From patchwork Tue Oct 5 09:29:39 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 66776 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 8A629B6F06 for ; Tue, 5 Oct 2010 20:29:54 +1100 (EST) Received: (qmail 14756 invoked by alias); 5 Oct 2010 09:29:52 -0000 Received: (qmail 14731 invoked by uid 22791); 5 Oct 2010 09:29:49 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, TW_PR, T_RP_MATCHES_RCVD, WEIRD_QUOTING 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; Tue, 05 Oct 2010 09:29:42 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B13C929000A; Tue, 5 Oct 2010 11:29:39 +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 26Jmi465fRTG; Tue, 5 Oct 2010 11:29:39 +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 97424290009; Tue, 5 Oct 2010 11:29:39 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 732D1D9BB5; Tue, 5 Oct 2010 11:29:39 +0200 (CEST) Date: Tue, 5 Oct 2010 11:29:39 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Emmanuel Briot Subject: [Ada] Code refactoring Message-ID: <20101005092939.GA17402@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 Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-05 Emmanuel Briot * prj-nmsc.adb, prj-err.adb (Expand_Subdirectory_Pattern): New subprogram. Extract some code from Get_Directories, to share with the handling of aggregate projects (for the Project_Files attributes) Index: prj-nmsc.adb =================================================================== --- prj-nmsc.adb (revision 164969) +++ prj-nmsc.adb (working copy) @@ -211,6 +211,33 @@ package body Prj.Nmsc is -- exceptions, and copied into the Source_Names and Unit_Exceptions tables -- as appropriate. + type Search_Type is (Search_Files, Search_Directories); + pragma Unreferenced (Search_Files); + + generic + with procedure Callback + (Path_Id : Path_Name_Type; + Display_Path_Id : Path_Name_Type; + Pattern_Index : Natural); + procedure Expand_Subdirectory_Pattern + (Project : Project_Id; + Data : in out Tree_Processing_Data; + Patterns : String_List_Id; + Search_For : Search_Type; + Resolve_Links : Boolean); + -- Search the subdirectories of Project's directory for files or + -- directories that match the globbing patterns found in Patterns (for + -- instance "**/*.adb"). Typically, Patterns will be the value of the + -- Source_Dirs or Excluded_Source_Dirs attributes. + -- Every time such a file or directory is found, the callback is called. + -- Resolve_Links indicates whether we should resolve links while + -- normalizing names. + -- In the callback, Pattern_Index is the index within Patterns where the + -- expanded pattern was found (1 for the first element of Patterns and + -- all its matching directories, then 2,...). + -- We use a generic and not an access-to-subprogram because in some cases + -- this code is compiled with the restriction No_Implicit_Dynamic_Code + procedure Add_Source (Id : out Source_Id; Data : in out Tree_Processing_Data; @@ -4853,19 +4880,6 @@ package body Prj.Nmsc is (Project : Project_Id; Data : in out Tree_Processing_Data) is - package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable - (Header_Num => Header_Num, - Element => Boolean, - No_Element => False, - Key => Path_Name_Type, - Hash => Hash, - Equal => "="); - -- Hash table stores recursive source directories, to avoid looking - -- several times, and to avoid cycles that may be introduced by symbolic - -- links. - - Visited : Recursive_Dirs.Instance; - Object_Dir : constant Variable_Value := Util.Value_Of (Name_Object_Dir, Project.Decl.Attributes, Data.Tree); @@ -4894,25 +4908,21 @@ package body Prj.Nmsc is Languages : constant Variable_Value := Prj.Util.Value_Of - (Name_Languages, Project.Decl.Attributes, Data.Tree); + (Name_Languages, Project.Decl.Attributes, Data.Tree); - procedure Find_Source_Dirs - (From : File_Name_Type; - Location : Source_Ptr; - Rank : Natural; - Removed : Boolean := False); - -- Find one or several source directories, and add (or remove, if - -- Removed is True) them to list of source directories of the project. + Remove_Source_Dirs : Boolean := False; procedure Add_To_Or_Remove_From_Source_Dirs (Path_Id : Path_Name_Type; Display_Path_Id : Path_Name_Type; - Rank : Natural; - Removed : Boolean); + Rank : Natural); -- When Removed = False, the directory Path_Id to the list of -- source_dirs if not already in the list. When Removed = True, -- removed directory Path_Id if in the list. + procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern + (Add_To_Or_Remove_From_Source_Dirs); + --------------------------------------- -- Add_To_Or_Remove_From_Source_Dirs -- --------------------------------------- @@ -4920,8 +4930,7 @@ package body Prj.Nmsc is procedure Add_To_Or_Remove_From_Source_Dirs (Path_Id : Path_Name_Type; Display_Path_Id : Path_Name_Type; - Rank : Natural; - Removed : Boolean) + Rank : Natural) is List : String_List_Id; Prev : String_List_Id; @@ -4945,7 +4954,7 @@ package body Prj.Nmsc is -- The directory is in the list if List is not Nil_String - if not Removed and then List = Nil_String then + if not Remove_Source_Dirs and then List = Nil_String then if Current_Verbosity = High then Write_Str (" Adding Source Dir="); Write_Line (Get_Name_String (Display_Path_Id)); @@ -4991,7 +5000,7 @@ package body Prj.Nmsc is Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) := (Number => Rank, Next => No_Number_List); - elsif Removed and then List /= Nil_String then + elsif Remove_Source_Dirs and then List /= Nil_String then -- Remove source dir, if present @@ -5010,247 +5019,6 @@ package body Prj.Nmsc is end if; end Add_To_Or_Remove_From_Source_Dirs; - ---------------------- - -- Find_Source_Dirs -- - ---------------------- - - procedure Find_Source_Dirs - (From : File_Name_Type; - Location : Source_Ptr; - Rank : Natural; - Removed : Boolean := False) - is - Directory : constant String := Get_Name_String (From); - - procedure Recursive_Find_Dirs (Path : Name_Id); - -- Find all the subdirectories (recursively) of Path and add them - -- to the list of source directories of the project. - - ------------------------- - -- Recursive_Find_Dirs -- - ------------------------- - - procedure Recursive_Find_Dirs (Path : Name_Id) is - Dir : Dir_Type; - Name : String (1 .. 250); - Last : Natural; - - Non_Canonical_Path : Path_Name_Type := No_Path; - Canonical_Path : Path_Name_Type := No_Path; - - The_Path : constant String := - Normalize_Pathname - (Get_Name_String (Path), - Directory => - Get_Name_String (Project.Directory.Display_Name), - Resolve_Links => Opt.Follow_Links_For_Dirs) & - Directory_Separator; - - The_Path_Last : constant Natural := - Compute_Directory_Last (The_Path); - - begin - Name_Len := The_Path_Last - The_Path'First + 1; - Name_Buffer (1 .. Name_Len) := - The_Path (The_Path'First .. The_Path_Last); - Non_Canonical_Path := Name_Find; - Canonical_Path := - Path_Name_Type - (Canonical_Case_File_Name (Name_Id (Non_Canonical_Path))); - - -- To avoid processing the same directory several times, check - -- if the directory is already in Recursive_Dirs. If it is, then - -- there is nothing to do, just return. If it is not, put it there - -- and continue recursive processing. - - if not Removed then - if Recursive_Dirs.Get (Visited, Canonical_Path) then - return; - else - Recursive_Dirs.Set (Visited, Canonical_Path, True); - end if; - end if; - - Add_To_Or_Remove_From_Source_Dirs - (Path_Id => Canonical_Path, - Display_Path_Id => Non_Canonical_Path, - Rank => Rank, - Removed => Removed); - - -- Now look for subdirectories. Do that even when this directory - -- is already in the list, because some of its subdirectories may - -- not be in the list yet. - - Open (Dir, The_Path (The_Path'First .. The_Path_Last)); - - loop - Read (Dir, Name, Last); - exit when Last = 0; - - if Name (1 .. Last) /= "." - and then Name (1 .. Last) /= ".." - then - -- Avoid . and .. directories - - if Current_Verbosity = High then - Write_Str (" Checking "); - Write_Line (Name (1 .. Last)); - end if; - - declare - Path_Name : constant String := - Normalize_Pathname - (Name => Name (1 .. Last), - Directory => - The_Path - (The_Path'First .. The_Path_Last), - Resolve_Links => - Opt.Follow_Links_For_Dirs, - Case_Sensitive => True); - - begin - if Is_Directory (Path_Name) then - - -- We have found a new subdirectory, call self - - Name_Len := Path_Name'Length; - Name_Buffer (1 .. Name_Len) := Path_Name; - Recursive_Find_Dirs (Name_Find); - end if; - end; - end if; - end loop; - - Close (Dir); - - exception - when Directory_Error => - null; - end Recursive_Find_Dirs; - - -- Start of processing for Find_Source_Dirs - - begin - if Current_Verbosity = High and then not Removed then - Write_Str ("Find_Source_Dirs ("""); - Write_Str (Directory); - Write_Str (","); - Write_Str (Rank'Img); - Write_Line (""")"); - end if; - - -- First, check if we are looking for a directory tree, indicated - -- by "/**" at the end. - - if Directory'Length >= 3 - and then Directory (Directory'Last - 1 .. Directory'Last) = "**" - and then (Directory (Directory'Last - 2) = '/' - or else - Directory (Directory'Last - 2) = Directory_Separator) - then - Name_Len := Directory'Length - 3; - - if Name_Len = 0 then - - -- Case of "/**": all directories in file system - - Name_Len := 1; - Name_Buffer (1) := Directory (Directory'First); - - else - Name_Buffer (1 .. Name_Len) := - Directory (Directory'First .. Directory'Last - 3); - end if; - - if Current_Verbosity = High then - Write_Str ("Looking for all subdirectories of """); - Write_Str (Name_Buffer (1 .. Name_Len)); - Write_Line (""""); - end if; - - declare - Base_Dir : constant File_Name_Type := Name_Find; - Root_Dir : constant String := - Normalize_Pathname - (Name => Name_Buffer (1 .. Name_Len), - Directory => - Get_Name_String - (Project.Directory.Display_Name), - Resolve_Links => - Opt.Follow_Links_For_Dirs, - Case_Sensitive => True); - Has_Error : Boolean := False; - - begin - if Root_Dir'Length = 0 then - Err_Vars.Error_Msg_File_1 := Base_Dir; - Error_Or_Warning - (Data.Flags, Data.Flags.Missing_Source_Files, - "{ is not a valid directory.", Location, Project); - Has_Error := Data.Flags.Missing_Source_Files = Error; - end if; - - if not Has_Error then - - -- We have an existing directory, we register it and all of - -- its subdirectories. - - if Current_Verbosity = High then - Write_Line ("Looking for source directories:"); - end if; - - Name_Len := Root_Dir'Length; - Name_Buffer (1 .. Name_Len) := Root_Dir; - Recursive_Find_Dirs (Name_Find); - - if Current_Verbosity = High then - Write_Line ("End of looking for source directories."); - end if; - end if; - end; - - -- We have a single directory - - else - declare - Path_Name : Path_Information; - Dir_Exists : Boolean; - Has_Error : Boolean := False; - - begin - Locate_Directory - (Project => Project, - Name => From, - Path => Path_Name, - Dir_Exists => Dir_Exists, - Data => Data, - Must_Exist => False); - - if not Dir_Exists then - Err_Vars.Error_Msg_File_1 := From; - Error_Or_Warning - (Data.Flags, Data.Flags.Missing_Source_Files, - "{ is not a valid directory", Location, Project); - Has_Error := Data.Flags.Missing_Source_Files = Error; - end if; - - if not Has_Error then - - -- Links have been resolved if necessary, and Path_Name - -- always ends with a directory separator. - - Add_To_Or_Remove_From_Source_Dirs - (Path_Id => Path_Name.Name, - Display_Path_Id => Path_Name.Display_Name, - Rank => Rank, - Removed => Removed); - end if; - end; - end if; - - Recursive_Dirs.Reset (Visited); - end Find_Source_Dirs; - -- Local declarations Dir_Exists : Boolean; @@ -5422,62 +5190,41 @@ package body Prj.Nmsc is -- No Source_Dirs specified: the single source directory is the one -- containing the project file. + Remove_Source_Dirs := False; Add_To_Or_Remove_From_Source_Dirs (Path_Id => Project.Directory.Name, Display_Path_Id => Project.Directory.Display_Name, - Rank => 1, - Removed => False); + Rank => 1); else - declare - Source_Dir : String_List_Id; - Element : String_Element; - Rank : Natural; - begin - -- Process the source directories for each element of the list - - Source_Dir := Source_Dirs.Values; - Rank := 0; - while Source_Dir /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Source_Dir); - Rank := Rank + 1; - Find_Source_Dirs - (File_Name_Type (Element.Value), Element.Location, Rank); - Source_Dir := Element.Next; - end loop; + Remove_Source_Dirs := False; + Find_Source_Dirs + (Project => Project, + Data => Data, + Patterns => Source_Dirs.Values, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); - if Project.Source_Dirs = Nil_String - and then Project.Qualifier = Standard - then - Error_Msg - (Data.Flags, - "a standard project cannot have no source directories", - Source_Dirs.Location, Project); - end if; - end; + if Project.Source_Dirs = Nil_String + and then Project.Qualifier = Standard + then + Error_Msg + (Data.Flags, + "a standard project cannot have no source directories", + Source_Dirs.Location, Project); + end if; end if; if not Excluded_Source_Dirs.Default and then Excluded_Source_Dirs.Values /= Nil_String then - declare - Source_Dir : String_List_Id; - Element : String_Element; - - begin - -- Process the source directories for each element of the list - - Source_Dir := Excluded_Source_Dirs.Values; - while Source_Dir /= Nil_String loop - Element := Data.Tree.String_Elements.Table (Source_Dir); - Find_Source_Dirs - (File_Name_Type (Element.Value), - Element.Location, - 0, - Removed => True); - Source_Dir := Element.Next; - end loop; - end; + Remove_Source_Dirs := True; + Find_Source_Dirs + (Project => Project, + Data => Data, + Patterns => Excluded_Source_Dirs.Values, + Search_For => Search_Directories, + Resolve_Links => Opt.Follow_Links_For_Dirs); end if; if Current_Verbosity = High then @@ -6933,6 +6680,253 @@ package body Prj.Nmsc is end if; end Check_File; + --------------------------------- + -- Expand_Subdirectory_Pattern -- + --------------------------------- + + procedure Expand_Subdirectory_Pattern + (Project : Project_Id; + Data : in out Tree_Processing_Data; + Patterns : String_List_Id; + Search_For : Search_Type; + Resolve_Links : Boolean) + is + pragma Unreferenced (Search_For); + Project_Dir : constant String := + Get_Name_String (Project.Directory.Display_Name); + + package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable + (Header_Num => Header_Num, + Element => Boolean, + No_Element => False, + Key => Path_Name_Type, + Hash => Hash, + Equal => "="); + -- Hash table stores recursive source directories, to avoid looking + -- several times, and to avoid cycles that may be introduced by symbolic + -- links. + + Visited : Recursive_Dirs.Instance; + + procedure Find_Pattern + (Pattern : String; Rank : Natural; Location : Source_Ptr); + -- Find a specific pattern + + procedure Recursive_Find_Dirs (Normalized_Path : String; Rank : Natural); + -- Search all the subdirectories (recursively) of Path + + ------------------------- + -- Recursive_Find_Dirs -- + ------------------------- + + procedure Recursive_Find_Dirs + (Normalized_Path : String; Rank : Natural) + is + Dir : Dir_Type; + Name : String (1 .. 250); + Last : Natural; + + Non_Canonical_Path : Path_Name_Type := No_Path; + Canonical_Path : Path_Name_Type := No_Path; + + The_Path_Last : constant Natural := + Compute_Directory_Last (Normalized_Path); + + begin + Name_Len := 0; + Add_Str_To_Name_Buffer + (Normalized_Path (Normalized_Path'First .. The_Path_Last)); + Non_Canonical_Path := Name_Find; + + Canonical_Path := + Path_Name_Type + (Canonical_Case_File_Name (Name_Id (Non_Canonical_Path))); + + if Recursive_Dirs.Get (Visited, Canonical_Path) then + return; + end if; + + Recursive_Dirs.Set (Visited, Canonical_Path, True); + + Callback (Canonical_Path, Non_Canonical_Path, Rank); + + Open (Dir, Normalized_Path (Normalized_Path'First .. The_Path_Last)); + + loop + Read (Dir, Name, Last); + exit when Last = 0; + + if Name (1 .. Last) /= "." + and then Name (1 .. Last) /= ".." + then + if Current_Verbosity = High then + Write_Str (" Checking "); + Write_Line (Name (1 .. Last)); + end if; + + declare + Path_Name : constant String := + Normalize_Pathname + (Name => Name (1 .. Last), + Directory => + Normalized_Path + (Normalized_Path'First .. The_Path_Last), + Resolve_Links => Resolve_Links) + & Directory_Separator; + begin + if Is_Directory (Path_Name) then + Recursive_Find_Dirs (Path_Name, Rank); + end if; + end; + end if; + end loop; + + Close (Dir); + + exception + when Directory_Error => + null; + end Recursive_Find_Dirs; + + ------------------ + -- Find_Pattern -- + ------------------ + + procedure Find_Pattern + (Pattern : String; Rank : Natural; Location : Source_Ptr) is + begin + if Current_Verbosity = High then + Write_Str ("Expand_Subdirectory_Pattern ("""); + Write_Str (Pattern); + Write_Line (""")"); + end if; + + -- First, check if we are looking for a directory tree, indicated + -- by "/**" at the end. + + if Pattern'Length >= 3 + and then Pattern (Pattern'Last - 1 .. Pattern'Last) = "**" + and then (Pattern (Pattern'Last - 2) = '/' + or else Pattern (Pattern'Last - 2) = Directory_Separator) + then + Name_Len := Pattern'Length - 3; + + if Name_Len = 0 then + + -- Case of "/**": all directories in file system + + Name_Len := 1; + Name_Buffer (1) := Pattern (Pattern'First); + + else + Name_Buffer (1 .. Name_Len) := + Pattern (Pattern'First .. Pattern'Last - 3); + end if; + + if Current_Verbosity = High then + Write_Str ("Looking for all subdirectories of """); + Write_Str (Name_Buffer (1 .. Name_Len)); + Write_Line (""""); + end if; + + declare + Base_Dir : constant File_Name_Type := Name_Find; + Root_Dir : constant String := + Normalize_Pathname + (Name => Name_Buffer (1 .. Name_Len), + Directory => Project_Dir, + Resolve_Links => Resolve_Links); + Has_Error : Boolean := False; + + begin + if Root_Dir'Length = 0 then + Err_Vars.Error_Msg_File_1 := Base_Dir; + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, + "{ is not a valid directory.", Location, Project); + Has_Error := Data.Flags.Missing_Source_Files = Error; + end if; + + if not Has_Error then + + -- We have an existing directory, we register it and all of + -- its subdirectories. + + if Current_Verbosity = High then + Write_Line ("Looking for source directories:"); + end if; + + if Root_Dir (Root_Dir'Last) /= Directory_Separator then + Recursive_Find_Dirs + (Root_Dir & Directory_Separator, Rank); + else + Recursive_Find_Dirs (Root_Dir, Rank); + end if; + + if Current_Verbosity = High then + Write_Line ("End of looking for source directories."); + end if; + end if; + end; + + -- We have a single directory + + else + declare + Directory : File_Name_Type; + Path_Name : Path_Information; + Dir_Exists : Boolean; + Has_Error : Boolean := False; + + begin + Name_Len := Pattern'Length; + Name_Buffer (1 .. Name_Len) := Pattern; + Directory := Name_Find; + + Locate_Directory + (Project => Project, + Name => Directory, + Path => Path_Name, + Dir_Exists => Dir_Exists, + Data => Data, + Must_Exist => False); + + if not Dir_Exists then + Err_Vars.Error_Msg_File_1 := Directory; + Error_Or_Warning + (Data.Flags, Data.Flags.Missing_Source_Files, + "{ is not a valid directory", Location, Project); + Has_Error := Data.Flags.Missing_Source_Files = Error; + end if; + + if not Has_Error then + + -- Links have been resolved if necessary, and Path_Name + -- always ends with a directory separator. + + Callback (Path_Name.Name, Path_Name.Display_Name, Rank); + end if; + end; + end if; + end Find_Pattern; + + -- Start of processing for Expand_Subdirectory_Pattern + + Pattern_Id : String_List_Id := Patterns; + Element : String_Element; + Rank : Natural := 1; + begin + while Pattern_Id /= Nil_String loop + Element := Data.Tree.String_Elements.Table (Pattern_Id); + Find_Pattern + (Get_Name_String (Element.Value), Rank, Element.Location); + Rank := Rank + 1; + Pattern_Id := Element.Next; + end loop; + + Recursive_Dirs.Reset (Visited); + end Expand_Subdirectory_Pattern; + ------------------------ -- Search_Directories -- ------------------------ Index: prj-err.adb =================================================================== --- prj-err.adb (revision 164906) +++ prj-err.adb (working copy) @@ -95,6 +95,10 @@ package body Prj.Err is -- so we shouldn't report errors for projects that the user has no -- access to in any case. + if Current_Verbosity = High then + Write_Line ("Error in in-memory project, ignored"); + end if; + return; end if;