diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-05-20 12:45:54 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-05-20 12:45:54 +0000 |
| commit | ba381ae5404608221a17b0f895bade166e5cb587 (patch) | |
| tree | 4f65013f967ac2ea1c063adc21103b17e57712c4 /gcc/ada/prj-makr.adb | |
| parent | 4ef962616dc83114d9e1312777963c0ce6e9b97a (diff) | |
| download | gcc-ba381ae5404608221a17b0f895bade166e5cb587.tar.gz | |
2008-05-20 Vincent Celier <celier@adacore.com>
* prj.adb (Hash (Project_Id)): New function
(Project_Empty): Add new component Interfaces_Defined
* prj.ads (Source_Data): New component Object_Linked
(Language_Config): New components Object_Generated and Objects_Linked
(Hash (Project_Id)): New function
(Source_Data): New Boolean components In_Interfaces and
Declared_In_Interfaces.
(Project_Data): New Boolean component Interfaces_Defined
* prj-attr.adb:
New project level attribute Object_Generated and Objects_Linked
Add new project level attribute Interfaces
* prj-dect.adb: Use functions Present and No throughout
(Parse_Variable_Declaration): If a string type is specified as a simple
name and is not found in the current project, look for it also in the
ancestors of the project.
* prj-makr.adb:
Replace procedure Make with procedures Initialize, Process and Finalize
to implement H414-023: process different directories with different
patterns.
Use functions Present and No throughout
* prj-makr.ads:
Replace procedure Make with procedures Initialize, Process and Finalize
* prj-nmsc.adb
(Add_Source): Set component Object_Exists and Object_Linked accordnig to
the language configuration.
(Process_Project_Level_Array_Attributes): Process new attributes
Object_Generated and Object_Linked.
(Report_No_Sources): New Boolean parameter Continuation, defaulted to
False, to indicate that the erreor/warning is a continuation.
(Check): Call Report_No_Sources with Contnuation = True after the first
call.
(Error_Msg): Process successively contnuation character and warning
character.
(Find_Explicit_Sources): Check that all declared sources have been found
(Check_File): Indicate in hash table Source_Names when a declared source
is found.
(Check_File): Set Other_Part when found
(Find_Explicit_Sources): In multi language mode, check if all exceptions
to the naming scheme have been found. For Ada, report an error if an
exception has not been found. Otherwise, disregard the exception.
(Check_Interfaces): New procedure
(Add_Source): When Other_Part is defined, set mutual pointers in spec
and body.
(Check): In multi-language mode, call Check_Interfaces
(Process_Sources_In_Multi_Language_Mode): Set In_Interfaces to False
for an excluded source.
(Remove_Source): A source replacing a source in the interfaces is also
in the interfaces.
* prj-pars.adb: Use function Present
* prj-part.adb: Use functions Present and No throughout
(Parse_Single_Project): Set the parent project for child projects
(Create_Virtual_Extending_Project): Register project with no qualifier
(Parse_Single_Project): Allow an abstract project to be extend several
times. Do not allow an abstract project to extend a non abstract
project.
* prj-pp.adb: Use functions Present and No throughout
(Print): Take into account the full associative array attribute
declarations.
* prj-proc.adb: Use functions Present and No throughout
(Expression): Call itself with the same From_Project_Node for the
default value of an external reference.
* prj-strt.adb: Use functions Present and No throughout
(Parse_Variable_Reference): If a variable is specified as a simple name
and is not found in the current project, look for it also in the
ancestors of the project.
* prj-tree.ads, prj-tree.adb (Present): New function
(No): New function
Use functions Present and No throughout
(Parent_Project_Of): New function
(Set_Parent_Project_Of): New procedure
* snames.ads, snames.adb:
Add new standard names Object_Generated and Objects_Linked
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@135623 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/prj-makr.adb')
| -rw-r--r-- | gcc/ada/prj-makr.adb | 1848 |
1 files changed, 922 insertions, 926 deletions
diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 336c676e748..a3997f0968b 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -41,7 +41,6 @@ with GNAT.Directory_Operations; use GNAT.Directory_Operations; with System.Case_Util; use System.Case_Util; with System.CRTL; -with System.Regexp; use System.Regexp; package body Prj.Makr is @@ -50,6 +49,55 @@ package body Prj.Makr is -- All the following need comments ??? All global variables and -- subprograms must be fully commented. + Very_Verbose : Boolean := False; + -- Set in call to Initialize to indicate very verbose output + + Project_File : Boolean := False; + -- True when gnatname is creating/modifying a project file. False when + -- gnatname is creating a configuration pragmas file. + + Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; + -- The project tree where the project file is parsed + + Args : Argument_List_Access; + -- The list of arguments for calls to the compiler to get the unit names + -- and kinds (spec or body) in the Ada sources. + + Path_Name : String_Access; + + Path_Last : Natural; + + Directory_Last : Natural := 0; + + Output_Name : String_Access; + Output_Name_Last : Natural; + Output_Name_Id : Name_Id; + + Project_Naming_File_Name : String_Access; + -- String (1 .. Output_Name'Length + Naming_File_Suffix'Length); + + Project_Naming_Last : Natural; + Project_Naming_Id : Name_Id := No_Name; + + Source_List_Path : String_Access; + -- (1 .. Output_Name'Length + Source_List_File_Suffix'Length); + Source_List_Last : Natural; + + Source_List_FD : File_Descriptor; + + Project_Node : Project_Node_Id := Empty_Node; + Project_Declaration : Project_Node_Id := Empty_Node; + Source_Dirs_List : Project_Node_Id := Empty_Node; + + Project_Naming_Node : Project_Node_Id := Empty_Node; + Project_Naming_Decl : Project_Node_Id := Empty_Node; + Naming_Package : Project_Node_Id := Empty_Node; + Naming_Package_Comments : Project_Node_Id := Empty_Node; + + Source_Files_Comments : Project_Node_Id := Empty_Node; + Source_Dirs_Comments : Project_Node_Id := Empty_Node; + Source_List_File_Comments : Project_Node_Id := Empty_Node; + Naming_String : aliased String := "naming"; Gnatname_Packages : aliased String_List := (1 => Naming_String'Access); @@ -91,6 +139,36 @@ package body Prj.Makr is Table_Initial => 10, Table_Increment => 100, Table_Name => "Prj.Makr.Processed_Directories"); + -- The list of already processed directories for each section, to avoid + -- processing several times the same directory in the same section. + + package Source_Directories is new Table.Table + (Table_Component_Type => String_Access, + Table_Index_Type => Natural, + Table_Low_Bound => 0, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Prj.Makr.Source_Directories"); + -- The complete list of directories to be put in attribute Source_Dirs in + -- the project file. + + type Source is record + File_Name : Name_Id; + Unit_Name : Name_Id; + Index : Int := 0; + Spec : Boolean; + end record; + + package Sources is new Table.Table + (Table_Component_Type => Source, + Table_Index_Type => Natural, + Table_Low_Bound => 0, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Prj.Makr.Sources"); + -- The list of Ada sources found, with their unit name and kind, to be put + -- in the source attribute and package Naming of the project file, or in + -- the pragmas Source_File_Name in the configuration pragmas file. --------- -- Dup -- @@ -112,566 +190,588 @@ package body Prj.Makr is Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd)); end Dup2; - ---------- - -- Make -- - ---------- - - procedure Make - (File_Path : String; - Project_File : Boolean; - Directories : Argument_List; - Name_Patterns : Argument_List; - Excluded_Patterns : Argument_List; - Foreign_Patterns : Argument_List; - Preproc_Switches : Argument_List; - Very_Verbose : Boolean) - is - Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data; - - Path_Name : String (1 .. File_Path'Length + - Project_File_Extension'Length); - Path_Last : Natural := File_Path'Length; - - Directory_Last : Natural := 0; - - Output_Name : String (Path_Name'Range); - Output_Name_Last : Natural; - Output_Name_Id : Name_Id; - - Project_Node : Project_Node_Id := Empty_Node; - Project_Declaration : Project_Node_Id := Empty_Node; - Source_Dirs_List : Project_Node_Id := Empty_Node; - Current_Source_Dir : Project_Node_Id := Empty_Node; - - Project_Naming_Node : Project_Node_Id := Empty_Node; - Project_Naming_Decl : Project_Node_Id := Empty_Node; - Naming_Package : Project_Node_Id := Empty_Node; - Naming_Package_Comments : Project_Node_Id := Empty_Node; + -------------- + -- Finalize -- + -------------- - Source_Files_Comments : Project_Node_Id := Empty_Node; - Source_Dirs_Comments : Project_Node_Id := Empty_Node; - Source_List_File_Comments : Project_Node_Id := Empty_Node; + procedure Finalize is + Discard : Boolean; + pragma Warnings (Off, Discard); - Project_Naming_File_Name : String (1 .. Output_Name'Length + - Naming_File_Suffix'Length); + Current_Source_Dir : Project_Node_Id := Empty_Node; - Project_Naming_Last : Natural; - Project_Naming_Id : Name_Id := No_Name; + begin + if Project_File then + -- If there were no already existing project file, or if the parsing + -- was unsuccessful, create an empty project node with the correct + -- name and its project declaration node. - Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp; - Regular_Expressions : array (Name_Patterns'Range) of Regexp; - Foreign_Expressions : array (Foreign_Patterns'Range) of Regexp; + if No (Project_Node) then + Project_Node := + Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); + Set_Name_Of (Project_Node, Tree, To => Output_Name_Id); + Set_Project_Declaration_Of + (Project_Node, Tree, + To => Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => Tree)); - Source_List_Path : String (1 .. Output_Name'Length + - Source_List_File_Suffix'Length); - Source_List_Last : Natural; + end if; - Source_List_FD : File_Descriptor; + end if; - Args : Argument_List (1 .. Preproc_Switches'Length + 6); + -- Delete the file if it already exists - type SFN_Pragma is record - Unit : Name_Id; - File : Name_Id; - Index : Int := 0; - Spec : Boolean; - end record; + Delete_File + (Path_Name (Directory_Last + 1 .. Path_Last), + Success => Discard); - package SFN_Pragmas is new Table.Table - (Table_Component_Type => SFN_Pragma, - Table_Index_Type => Natural, - Table_Low_Bound => 0, - Table_Initial => 50, - Table_Increment => 100, - Table_Name => "Prj.Makr.SFN_Pragmas"); + -- Create a new one - procedure Process_Directory (Dir_Name : String; Recursively : Boolean); - -- Look for Ada and foreign sources in a directory, according to the - -- patterns. When Recursively is True, after looking for sources in - -- Dir_Name, look also in its subdirectories, if any. + if Opt.Verbose_Mode then + Output.Write_Str ("Creating new file """); + Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last)); + Output.Write_Line (""""); + end if; - ----------------------- - -- Process_Directory -- - ----------------------- + Output_FD := Create_New_File + (Path_Name (Directory_Last + 1 .. Path_Last), + Fmode => Text); - procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is - Matched : Matched_Type := False; - Str : String (1 .. 2_000); - Canon : String (1 .. 2_000); - Last : Natural; - Dir : Dir_Type; - Process : Boolean := True; + -- Fails if project file cannot be created - Temp_File_Name : String_Access := null; - Save_Last_Pragma_Index : Natural := 0; - File_Name_Id : Name_Id := No_Name; - SFN_Prag : SFN_Pragma; + if Output_FD = Invalid_FD then + Prj.Com.Fail + ("cannot create new """, Path_Name (1 .. Path_Last), """"); + end if; - begin - -- Avoid processing the same directory more than once + if Project_File then - for Index in 1 .. Processed_Directories.Last loop - if Processed_Directories.Table (Index).all = Dir_Name then - Process := False; - exit; - end if; - end loop; + -- Delete the source list file, if it already exists - if Process then - if Opt.Verbose_Mode then - Output.Write_Str ("Processing directory """); - Output.Write_Str (Dir_Name); - Output.Write_Line (""""); - end if; + declare + Discard : Boolean; + pragma Warnings (Off, Discard); + begin + Delete_File + (Source_List_Path (1 .. Source_List_Last), + Success => Discard); + end; - Processed_Directories. Increment_Last; - Processed_Directories.Table (Processed_Directories.Last) := - new String'(Dir_Name); + -- And create a new source list file. Fail if file cannot be created. - -- Get the source file names from the directory. Fails if the - -- directory does not exist. + Source_List_FD := Create_New_File + (Name => Source_List_Path (1 .. Source_List_Last), + Fmode => Text); - begin - Open (Dir, Dir_Name); - exception - when Directory_Error => - Prj.Com.Fail ("cannot open directory """, Dir_Name, """"); - end; + if Source_List_FD = Invalid_FD then + Prj.Com.Fail + ("cannot create file """, + Source_List_Path (1 .. Source_List_Last), + """"); + end if; - -- Process each regular file in the directory + if Opt.Verbose_Mode then + Output.Write_Str ("Naming project file name is """); + Output.Write_Str + (Project_Naming_File_Name (1 .. Project_Naming_Last)); + Output.Write_Line (""""); + end if; - File_Loop : loop - Read (Dir, Str, Last); - exit File_Loop when Last = 0; + -- Create the naming project node - -- Copy the file name and put it in canonical case to match - -- against the patterns that have themselves already been put - -- in canonical case. + Project_Naming_Node := + Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); + Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id); + Project_Naming_Decl := + Default_Project_Node + (Of_Kind => N_Project_Declaration, In_Tree => Tree); + Set_Project_Declaration_Of + (Project_Naming_Node, Tree, Project_Naming_Decl); + Naming_Package := + Default_Project_Node + (Of_Kind => N_Package_Declaration, In_Tree => Tree); + Set_Name_Of (Naming_Package, Tree, To => Name_Naming); - Canon (1 .. Last) := Str (1 .. Last); - Canonical_Case_File_Name (Canon (1 .. Last)); + -- Add an attribute declaration for Source_Files as an empty list (to + -- indicate there are no sources in the naming project) and a package + -- Naming (that will be filled later). - if Is_Regular_File - (Dir_Name & Directory_Separator & Str (1 .. Last)) - then - Matched := True; + declare + Decl_Item : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Declarative_Item, In_Tree => Tree); - Name_Len := Last; - Name_Buffer (1 .. Name_Len) := Str (1 .. Last); - File_Name_Id := Name_Find; + Attribute : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => List); - -- First, check if the file name matches at least one of - -- the excluded expressions; + Expression : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => List); - for Index in Excluded_Expressions'Range loop - if - Match (Canon (1 .. Last), Excluded_Expressions (Index)) - then - Matched := Excluded; - exit; - end if; - end loop; + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => List); - -- If it does not match any of the excluded expressions, - -- check if the file name matches at least one of the - -- regular expressions. + Empty_List : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String_List, + In_Tree => Tree); - if Matched = True then - Matched := False; + begin + Set_First_Declarative_Item_Of + (Project_Naming_Decl, Tree, To => Decl_Item); + Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); + Set_Name_Of (Attribute, Tree, To => Name_Source_Files); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Empty_List); + end; - for Index in Regular_Expressions'Range loop - if - Match - (Canon (1 .. Last), Regular_Expressions (Index)) - then - Matched := True; - exit; - end if; - end loop; - end if; + -- Add a with clause on the naming project in the main project, if + -- there is not already one. - if Very_Verbose - or else (Matched = True and then Opt.Verbose_Mode) - then - Output.Write_Str (" Checking """); - Output.Write_Str (Str (1 .. Last)); - Output.Write_Line (""": "); - end if; + declare + With_Clause : Project_Node_Id := + First_With_Clause_Of (Project_Node, Tree); - -- If the file name matches one of the regular expressions, - -- parse it to get its unit name. + begin + while Present (With_Clause) loop + exit when + Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id; + With_Clause := Next_With_Clause_Of (With_Clause, Tree); + end loop; - if Matched = True then - declare - FD : File_Descriptor; - Success : Boolean; - Saved_Output : File_Descriptor; - Saved_Error : File_Descriptor; + if No (With_Clause) then + With_Clause := Default_Project_Node + (Of_Kind => N_With_Clause, In_Tree => Tree); + Set_Next_With_Clause_Of + (With_Clause, Tree, + To => First_With_Clause_Of (Project_Node, Tree)); + Set_First_With_Clause_Of + (Project_Node, Tree, To => With_Clause); + Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id); - begin - -- If we don't have the path of the compiler yet, - -- get it now. The compiler name may have a prefix, - -- so we get the potentially prefixed name. + -- We set the project node to something different than + -- Empty_Node, so that Prj.PP does not generate a limited + -- with clause. - if Gcc_Path = null then - declare - Prefix_Gcc : String_Access := - Program_Name (Gcc); - begin - Gcc_Path := - Locate_Exec_On_Path (Prefix_Gcc.all); - Free (Prefix_Gcc); - end; + Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node); - if Gcc_Path = null then - Prj.Com.Fail ("could not locate " & Gcc); - end if; - end if; + Name_Len := Project_Naming_Last; + Name_Buffer (1 .. Name_Len) := + Project_Naming_File_Name (1 .. Project_Naming_Last); + Set_String_Value_Of (With_Clause, Tree, To => Name_Find); + end if; + end; - -- If we don't have yet the file name of the - -- temporary file, get it now. + Project_Declaration := Project_Declaration_Of (Project_Node, Tree); - if Temp_File_Name = null then - Create_Temp_File (FD, Temp_File_Name); + -- Add a package Naming in the main project, that is a renaming of + -- package Naming in the naming project. - if FD = Invalid_FD then - Prj.Com.Fail - ("could not create temporary file"); - end if; + declare + Decl_Item : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); - Close (FD); - Delete_File (Temp_File_Name.all, Success); - end if; + Naming : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Package_Declaration, + In_Tree => Tree); - Args (Args'Last) := new String' - (Dir_Name & - Directory_Separator & - Str (1 .. Last)); + begin + Set_Next_Declarative_Item + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); + Set_First_Declarative_Item_Of + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Naming); + Set_Name_Of (Naming, Tree, To => Name_Naming); + Set_Project_Of_Renamed_Package_Of + (Naming, Tree, To => Project_Naming_Node); - -- Create the temporary file + -- Attach the comments, if any, that were saved for package + -- Naming. - FD := Create_Output_Text_File - (Name => Temp_File_Name.all); + Tree.Project_Nodes.Table (Naming).Comments := + Naming_Package_Comments; + end; - if FD = Invalid_FD then - Prj.Com.Fail - ("could not create temporary file"); - end if; + -- Add an attribute declaration for Source_Dirs, initialized as an + -- empty list. - -- Save the standard output and error + declare + Decl_Item : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); - Saved_Output := Dup (Standout); - Saved_Error := Dup (Standerr); + Attribute : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => List); - -- Set standard output and error to the temporary file + Expression : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => List); - Dup2 (FD, Standout); - Dup2 (FD, Standerr); + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, In_Tree => Tree, + And_Expr_Kind => List); - -- And spawn the compiler + begin + Set_Next_Declarative_Item + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); + Set_First_Declarative_Item_Of + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); + Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); + Source_Dirs_List := + Default_Project_Node + (Of_Kind => N_Literal_String_List, + In_Tree => Tree, + And_Expr_Kind => List); + Set_Current_Term (Term, Tree, To => Source_Dirs_List); - Spawn (Gcc_Path.all, Args, Success); + -- Attach the comments, if any, that were saved for attribute + -- Source_Dirs. - -- Restore the standard output and error + Tree.Project_Nodes.Table (Attribute).Comments := + Source_Dirs_Comments; + end; - Dup2 (Saved_Output, Standout); - Dup2 (Saved_Error, Standerr); + -- Put the source directories in attribute Source_Dirs - -- Close the temporary file + for Source_Dir_Index in 1 .. Source_Directories.Last loop + declare + Expression : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => Single); - Close (FD); + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => Single); - -- And close the saved standard output and error to - -- avoid too many file descriptors. + Value : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => Tree, + And_Expr_Kind => Single); - Close (Saved_Output); - Close (Saved_Error); + begin + if No (Current_Source_Dir) then + Set_First_Expression_In_List + (Source_Dirs_List, Tree, To => Expression); + else + Set_Next_Expression_In_List + (Current_Source_Dir, Tree, To => Expression); + end if; - -- Now that standard output is restored, check if - -- the compiler ran correctly. + Current_Source_Dir := Expression; + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Value); + Name_Len := 0; + Add_Str_To_Name_Buffer + (Source_Directories.Table (Source_Dir_Index).all); + Set_String_Value_Of (Value, Tree, To => Name_Find); + end; + end loop; - -- Read the lines of the temporary file: - -- they should contain the kind and name of the unit. + -- Add an attribute declaration for Source_Files or Source_List_File + -- with the source list file name that will be created. - declare - File : Text_File; - Text_Line : String (1 .. 1_000); - Text_Last : Natural; + declare + Decl_Item : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Declarative_Item, + In_Tree => Tree); - begin - Open (File, Temp_File_Name.all); + Attribute : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Attribute_Declaration, + In_Tree => Tree, + And_Expr_Kind => Single); - if not Is_Valid (File) then - Prj.Com.Fail - ("could not read temporary file"); - end if; + Expression : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Expression, + In_Tree => Tree, + And_Expr_Kind => Single); - Save_Last_Pragma_Index := SFN_Pragmas.Last; + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + In_Tree => Tree, + And_Expr_Kind => Single); - if End_Of_File (File) then - if Opt.Verbose_Mode then - if not Success then - Output.Write_Str (" (process died) "); - end if; - end if; + Value : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, + In_Tree => Tree, + And_Expr_Kind => Single); - else - Line_Loop : while not End_Of_File (File) loop - Get_Line (File, Text_Line, Text_Last); + begin + Set_Next_Declarative_Item + (Decl_Item, Tree, + To => First_Declarative_Item_Of (Project_Declaration, Tree)); + Set_First_Declarative_Item_Of + (Project_Declaration, Tree, To => Decl_Item); + Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); - -- Find the first closing parenthesis + Set_Name_Of (Attribute, Tree, To => Name_Source_List_File); + Set_Expression_Of (Attribute, Tree, To => Expression); + Set_First_Term (Expression, Tree, To => Term); + Set_Current_Term (Term, Tree, To => Value); + Name_Len := Source_List_Last; + Name_Buffer (1 .. Name_Len) := + Source_List_Path (1 .. Source_List_Last); + Set_String_Value_Of (Value, Tree, To => Name_Find); - Char_Loop : for J in 1 .. Text_Last loop - if Text_Line (J) = ')' then - if J >= 13 and then - Text_Line (1 .. 4) = "Unit" - then - -- Add entry to SFN_Pragmas table + -- If there was no comments for attribute Source_List_File, put + -- those for Source_Files, if they exist. - Name_Len := J - 12; - Name_Buffer (1 .. Name_Len) := - Text_Line (6 .. J - 7); - SFN_Prag := - (Unit => Name_Find, - File => File_Name_Id, - Index => 0, - Spec => Text_Line (J - 5 .. J) = - "(spec)"); + if Present (Source_List_File_Comments) then + Tree.Project_Nodes.Table (Attribute).Comments := + Source_List_File_Comments; + else + Tree.Project_Nodes.Table (Attribute).Comments := + Source_Files_Comments; + end if; + end; - SFN_Pragmas.Increment_Last; - SFN_Pragmas.Table - (SFN_Pragmas.Last) := SFN_Prag; - end if; - exit Char_Loop; - end if; - end loop Char_Loop; - end loop Line_Loop; - end if; + -- Put the sources in the source list files and in the naming + -- project. - if Save_Last_Pragma_Index = SFN_Pragmas.Last then - if Opt.Verbose_Mode then - Output.Write_Line (" not a unit"); - end if; + for Source_Index in 1 .. Sources.Last loop - else - if SFN_Pragmas.Last > - Save_Last_Pragma_Index + 1 - then - for Index in Save_Last_Pragma_Index + 1 .. - SFN_Pragmas.Last - loop - SFN_Pragmas.Table (Index).Index := - Int (Index - Save_Last_Pragma_Index); - end loop; - end if; + -- Add the corresponding attribute in the + -- Naming package of the naming project. - for Index in Save_Last_Pragma_Index + 1 .. - SFN_Pragmas.Last - loop - SFN_Prag := SFN_Pragmas.Table (Index); + declare + Current_Source : constant Source := + Sources.Table (Source_Index); - if Opt.Verbose_Mode then - if SFN_Prag.Spec then - Output.Write_Str (" spec of "); + Decl_Item : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => + N_Declarative_Item, + In_Tree => Tree); - else - Output.Write_Str (" body of "); - end if; + Attribute : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => + N_Attribute_Declaration, + In_Tree => Tree); + + Expression : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Expression, + And_Expr_Kind => Single, + In_Tree => Tree); + + Term : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Term, + And_Expr_Kind => Single, + In_Tree => Tree); + + Value : constant Project_Node_Id := + Default_Project_Node + (Of_Kind => N_Literal_String, + And_Expr_Kind => Single, + In_Tree => Tree); - Output.Write_Line - (Get_Name_String (SFN_Prag.Unit)); - end if; + begin + -- Add source file name to the source list file - if Project_File then + Get_Name_String (Current_Source.File_Name); + Add_Char_To_Name_Buffer (ASCII.LF); + if Write (Source_List_FD, + Name_Buffer (1)'Address, + Name_Len) /= Name_Len + then + Prj.Com.Fail ("disk full"); + end if; - -- Add the corresponding attribute in the - -- Naming package of the naming project. + -- For an Ada source, add entry in package Naming + + if Current_Source.Unit_Name /= No_Name then + Set_Next_Declarative_Item + (Decl_Item, + To => First_Declarative_Item_Of + (Naming_Package, Tree), + In_Tree => Tree); + Set_First_Declarative_Item_Of + (Naming_Package, + To => Decl_Item, + In_Tree => Tree); + Set_Current_Item_Node + (Decl_Item, + To => Attribute, + In_Tree => Tree); + + -- Is it a spec or a body? + + if Current_Source.Spec then + Set_Name_Of + (Attribute, Tree, + To => Name_Spec); + else + Set_Name_Of + (Attribute, Tree, + To => Name_Body); + end if; - declare - Decl_Item : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => - N_Declarative_Item, - In_Tree => Tree); + -- Get the name of the unit - Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => - N_Attribute_Declaration, - In_Tree => Tree); - - Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - And_Expr_Kind => Single, - In_Tree => Tree); - - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - And_Expr_Kind => Single, - In_Tree => Tree); - - Value : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String, - And_Expr_Kind => Single, - In_Tree => Tree); - - begin - Set_Next_Declarative_Item - (Decl_Item, - To => First_Declarative_Item_Of - (Naming_Package, Tree), - In_Tree => Tree); - Set_First_Declarative_Item_Of - (Naming_Package, - To => Decl_Item, - In_Tree => Tree); - Set_Current_Item_Node - (Decl_Item, - To => Attribute, - In_Tree => Tree); - - -- Is it a spec or a body? - - if SFN_Prag.Spec then - Set_Name_Of - (Attribute, Tree, - To => Name_Spec); - else - Set_Name_Of - (Attribute, Tree, - To => Name_Body); - end if; + Get_Name_String (Current_Source.Unit_Name); + To_Lower (Name_Buffer (1 .. Name_Len)); + Set_Associative_Array_Index_Of + (Attribute, Tree, To => Name_Find); - -- Get the name of the unit + Set_Expression_Of + (Attribute, Tree, To => Expression); + Set_First_Term + (Expression, Tree, To => Term); + Set_Current_Term + (Term, Tree, To => Value); - Get_Name_String (SFN_Prag.Unit); - To_Lower (Name_Buffer (1 .. Name_Len)); - Set_Associative_Array_Index_Of - (Attribute, Tree, To => Name_Find); + -- And set the name of the file - Set_Expression_Of - (Attribute, Tree, To => Expression); - Set_First_Term - (Expression, Tree, To => Term); - Set_Current_Term - (Term, Tree, To => Value); + Set_String_Value_Of + (Value, Tree, To => Current_Source.File_Name); + Set_Source_Index_Of + (Value, Tree, To => Current_Source.Index); + end if; + end; + end loop; - -- And set the name of the file + -- Close the source list file - Set_String_Value_Of - (Value, Tree, To => File_Name_Id); - Set_Source_Index_Of - (Value, Tree, To => SFN_Prag.Index); - end; - end if; - end loop; + Close (Source_List_FD); - if Project_File then - -- Add source file name to source list - -- file. + -- Output the project file - Last := Last + 1; - Str (Last) := ASCII.LF; + Prj.PP.Pretty_Print + (Project_Node, Tree, + W_Char => Write_A_Char'Access, + W_Eol => Write_Eol'Access, + W_Str => Write_A_String'Access, + Backward_Compatibility => False); + Close (Output_FD); - if Write (Source_List_FD, - Str (1)'Address, - Last) /= Last - then - Prj.Com.Fail ("disk full"); - end if; - end if; - end if; + -- Delete the naming project file if it already exists - Close (File); + Delete_File + (Project_Naming_File_Name (1 .. Project_Naming_Last), + Success => Discard); - Delete_File (Temp_File_Name.all, Success); - end; - end; + -- Create a new one - -- File name matches none of the regular expressions + if Opt.Verbose_Mode then + Output.Write_Str ("Creating new naming project file """); + Output.Write_Str (Project_Naming_File_Name + (1 .. Project_Naming_Last)); + Output.Write_Line (""""); + end if; - else - -- If file is not excluded, see if this is foreign source + Output_FD := Create_New_File + (Project_Naming_File_Name (1 .. Project_Naming_Last), + Fmode => Text); - if Matched /= Excluded then - for Index in Foreign_Expressions'Range loop - if Match (Canon (1 .. Last), - Foreign_Expressions (Index)) - then - Matched := True; - exit; - end if; - end loop; - end if; + -- Fails if naming project file cannot be created - if Very_Verbose then - case Matched is - when False => - Output.Write_Line ("no match"); + if Output_FD = Invalid_FD then + Prj.Com.Fail + ("cannot create new """, + Project_Naming_File_Name (1 .. Project_Naming_Last), + """"); + end if; - when Excluded => - Output.Write_Line ("excluded"); + -- Output the naming project file - when True => - Output.Write_Line ("foreign source"); - end case; - end if; + Prj.PP.Pretty_Print + (Project_Naming_Node, Tree, + W_Char => Write_A_Char'Access, + W_Eol => Write_Eol'Access, + W_Str => Write_A_String'Access, + Backward_Compatibility => False); + Close (Output_FD); - if Project_File and Matched = True then + else + -- For each Ada source, write a pragma Source_File_Name to the + -- configuration pragmas file. - -- Add source file name to source list file + for Index in 1 .. Sources.Last loop + if Sources.Table (Index).Unit_Name /= No_Name then + Write_A_String ("pragma Source_File_Name"); + Write_Eol; + Write_A_String (" ("); + Write_A_String + (Get_Name_String (Sources.Table (Index).Unit_Name)); + Write_A_String (","); + Write_Eol; - Last := Last + 1; - Str (Last) := ASCII.LF; + if Sources.Table (Index).Spec then + Write_A_String (" Spec_File_Name => """); - if Write (Source_List_FD, - Str (1)'Address, - Last) /= Last - then - Prj.Com.Fail ("disk full"); - end if; - end if; - end if; + else + Write_A_String (" Body_File_Name => """); end if; - end loop File_Loop; - - Close (Dir); - end if; - -- If Recursively is True, call itself for each subdirectory. - -- We do that, even when this directory has already been processed, - -- because all of its subdirectories may not have been processed. - - if Recursively then - Open (Dir, Dir_Name); - - loop - Read (Dir, Str, Last); - exit when Last = 0; + Write_A_String + (Get_Name_String (Sources.Table (Index).File_Name)); - -- Do not call itself for "." or ".." + Write_A_String (""""); - if Is_Directory - (Dir_Name & Directory_Separator & Str (1 .. Last)) - and then Str (1 .. Last) /= "." - and then Str (1 .. Last) /= ".." - then - Process_Directory - (Dir_Name & Directory_Separator & Str (1 .. Last), - Recursively => True); + if Sources.Table (Index).Index /= 0 then + Write_A_String (", Index =>"); + Write_A_String (Sources.Table (Index).Index'Img); end if; - end loop; - Close (Dir); - end if; - end Process_Directory; + Write_A_String (");"); + Write_Eol; + end if; + end loop; - -- Start of processing for Make + Close (Output_FD); + end if; + end Finalize; + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (File_Path : String; + Project_File : Boolean; + Preproc_Switches : Argument_List; + Very_Verbose : Boolean) + is begin + Makr.Very_Verbose := Initialize.Very_Verbose; + Makr.Project_File := Initialize.Project_File; + -- Do some needed initializations Csets.Initialize; @@ -680,12 +780,12 @@ package body Prj.Makr is Prj.Initialize (No_Project_Tree); Prj.Tree.Initialize (Tree); - SFN_Pragmas.Set_Last (0); - - Processed_Directories.Set_Last (0); + Sources.Set_Last (0); + Source_Directories.Set_Last (0); -- Initialize the compiler switches + Args := new Argument_List (1 .. Preproc_Switches'Length + 6); Args (1) := new String'("-c"); Args (2) := new String'("-gnats"); Args (3) := new String'("-gnatu"); @@ -695,6 +795,10 @@ package body Prj.Makr is -- Get the path and file names + Path_Name := new + String (1 .. File_Path'Length + Project_File_Extension'Length); + Path_Last := File_Path'Length; + if File_Names_Case_Sensitive then Path_Name (1 .. Path_Last) := File_Path; else @@ -722,8 +826,8 @@ package body Prj.Makr is Path_Last := Path_Name'Last; end if; - Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last)); - Output_Name_Last := Path_Last - Project_File_Extension'Length; + Output_Name := new String'(To_Lower (Path_Name (1 .. Path_Last))); + Output_Name_Last := Output_Name'Last - 4; -- If there is already a project file with the specified name, parse -- it to get the components that are not automatically generated. @@ -731,14 +835,14 @@ package body Prj.Makr is if Is_Regular_File (Output_Name (1 .. Path_Last)) then if Opt.Verbose_Mode then Output.Write_Str ("Parsing already existing project file """); - Output.Write_Str (Output_Name (1 .. Output_Name_Last)); + Output.Write_Str (Output_Name.all); Output.Write_Line (""""); end if; Part.Parse (In_Tree => Tree, Project => Project_Node, - Project_File_Name => Output_Name (1 .. Output_Name_Last), + Project_File_Name => Output_Name.all, Always_Errout_Finalize => False, Store_Comments => True, Current_Directory => Get_Current_Dir, @@ -746,7 +850,7 @@ package body Prj.Makr is -- Fail if parsing was not successful - if Project_Node = Empty_Node then + if No (Project_Node) then Fail ("parsing of existing project file failed"); else @@ -762,11 +866,11 @@ package body Prj.Makr is Previous : Project_Node_Id := Empty_Node; begin - while With_Clause /= Empty_Node loop + while Present (With_Clause) loop if Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id then - if Previous = Empty_Node then + if No (Previous) then Set_First_With_Clause_Of (Project_Node, Tree, To => Next_With_Clause_Of (With_Clause, Tree)); @@ -803,7 +907,7 @@ package body Prj.Makr is Comments : Project_Node_Id; begin - while Declaration /= Empty_Node loop + while Present (Declaration) loop Current_Node := Current_Item_Node (Declaration, Tree); Kind_Of_Node := Kind_Of (Current_Node, Tree); @@ -834,7 +938,7 @@ package body Prj.Makr is Naming_Package_Comments := Comments; end if; - if Previous = Empty_Node then + if No (Previous) then Set_First_Declarative_Item_Of (Project_Declaration_Of (Project_Node, Tree), Tree, @@ -874,12 +978,10 @@ package body Prj.Makr is -- Create the project naming file name Project_Naming_Last := Output_Name_Last; - Project_Naming_File_Name (1 .. Project_Naming_Last) := - Output_Name (1 .. Project_Naming_Last); - Project_Naming_File_Name - (Project_Naming_Last + 1 .. - Project_Naming_Last + Naming_File_Suffix'Length) := - Naming_File_Suffix; + Project_Naming_File_Name := + new String'(Output_Name (1 .. Output_Name_Last) & + Naming_File_Suffix & + Project_File_Extension); Project_Naming_Last := Project_Naming_Last + Naming_File_Suffix'Length; @@ -890,23 +992,17 @@ package body Prj.Makr is Project_Naming_File_Name (1 .. Name_Len); Project_Naming_Id := Name_Find; - Project_Naming_File_Name - (Project_Naming_Last + 1 .. - Project_Naming_Last + Project_File_Extension'Length) := - Project_File_Extension; Project_Naming_Last := Project_Naming_Last + Project_File_Extension'Length; -- Create the source list file name Source_List_Last := Output_Name_Last; - Source_List_Path (1 .. Source_List_Last) := - Output_Name (1 .. Source_List_Last); - Source_List_Path - (Source_List_Last + 1 .. - Source_List_Last + Source_List_File_Suffix'Length) := - Source_List_File_Suffix; - Source_List_Last := Source_List_Last + Source_List_File_Suffix'Length; + Source_List_Path := + new String'(Output_Name (1 .. Output_Name_Last) & + Source_List_File_Suffix); + Source_List_Last := + Output_Name_Last + Source_List_File_Suffix'Length; -- Add the project file extension to the project name @@ -915,6 +1011,7 @@ package body Prj.Makr is Output_Name_Last + Project_File_Extension'Length) := Project_File_Extension; Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; + end if; -- Change the current directory to the directory of the project file, @@ -931,544 +1028,443 @@ package body Prj.Makr is """"); end; end if; + end Initialize; + + ------------- + -- Process -- + ------------- + + procedure Process + (Directories : Argument_List; + Name_Patterns : Regexp_List; + Excluded_Patterns : Regexp_List; + Foreign_Patterns : Regexp_List) + is + procedure Process_Directory (Dir_Name : String; Recursively : Boolean); + -- Look for Ada and foreign sources in a directory, according to the + -- patterns. When Recursively is True, after looking for sources in + -- Dir_Name, look also in its subdirectories, if any. - if Project_File then - - -- Delete the source list file, if it already exists - - declare - Discard : Boolean; - pragma Warnings (Off, Discard); - begin - Delete_File - (Source_List_Path (1 .. Source_List_Last), - Success => Discard); - end; + ----------------------- + -- Process_Directory -- + ----------------------- - -- And create a new source list file. - -- Fail if file cannot be created. + procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is + Matched : Matched_Type := False; + Str : String (1 .. 2_000); + Canon : String (1 .. 2_000); + Last : Natural; + Dir : Dir_Type; + Do_Process : Boolean := True; - Source_List_FD := Create_New_File - (Name => Source_List_Path (1 .. Source_List_Last), - Fmode => Text); + Temp_File_Name : String_Access := null; + Save_Last_Source_Index : Natural := 0; + File_Name_Id : Name_Id := No_Name; - if Source_List_FD = Invalid_FD then - Prj.Com.Fail - ("cannot create file """, - Source_List_Path (1 .. Source_List_Last), - """"); - end if; - end if; + Current_Source : Source; - -- Compile the regular expressions. Fails immediately if any of - -- the specified strings is in error. + begin + -- Avoid processing the same directory more than once - for Index in Excluded_Expressions'Range loop - if Very_Verbose then - Output.Write_Str ("Excluded pattern: """); - Output.Write_Str (Excluded_Patterns (Index).all); - Output.Write_Line (""""); - end if; + for Index in 1 .. Processed_Directories.Last loop + if Processed_Directories.Table (Index).all = Dir_Name then + Do_Process := False; + exit; + end if; + end loop; - begin - Excluded_Expressions (Index) := - Compile (Pattern => Excluded_Patterns (Index).all, Glob => True); - exception - when Error_In_Regexp => - Prj.Com.Fail - ("invalid regular expression """, - Excluded_Patterns (Index).all, - """"); - end; - end loop; + if Do_Process then + if Opt.Verbose_Mode then + Output.Write_Str ("Processing directory """); + Output.Write_Str (Dir_Name); + Output.Write_Line (""""); + end if; - for Index in Foreign_Expressions'Range loop - if Very_Verbose then - Output.Write_Str ("Foreign pattern: """); - Output.Write_Str (Foreign_Patterns (Index).all); - Output.Write_Line (""""); - end if; + Processed_Directories. Increment_Last; + Processed_Directories.Table (Processed_Directories.Last) := + new String'(Dir_Name); - begin - Foreign_Expressions (Index) := - Compile (Pattern => Foreign_Patterns (Index).all, Glob => True); - exception - when Error_In_Regexp => - Prj.Com.Fail - ("invalid regular expression """, - Foreign_Patterns (Index).all, - """"); - end; - end loop; + -- Get the source file names from the directory. Fails if the + -- directory does not exist. - for Index in Regular_Expressions'Range loop - if Very_Verbose then - Output.Write_Str ("Pattern: """); - Output.Write_Str (Name_Patterns (Index).all); - Output.Write_Line (""""); - end if; + begin + Open (Dir, Dir_Name); + exception + when Directory_Error => + Prj.Com.Fail ("cannot open directory """, Dir_Name, """"); + end; - begin - Regular_Expressions (Index) := - Compile (Pattern => Name_Patterns (Index).all, Glob => True); + -- Process each regular file in the directory - exception - when Error_In_Regexp => - Prj.Com.Fail - ("invalid regular expression """, - Name_Patterns (Index).all, - """"); - end; - end loop; + File_Loop : loop + Read (Dir, Str, Last); + exit File_Loop when Last = 0; - if Project_File then - if Opt.Verbose_Mode then - Output.Write_Str ("Naming project file name is """); - Output.Write_Str - (Project_Naming_File_Name (1 .. Project_Naming_Last)); - Output.Write_Line (""""); - end if; + -- Copy the file name and put it in canonical case to match + -- against the patterns that have themselves already been put + -- in canonical case. - -- If there were no already existing project file, or if the parsing - -- was unsuccessful, create an empty project node with the correct - -- name and its project declaration node. + Canon (1 .. Last) := Str (1 .. Last); + Canonical_Case_File_Name (Canon (1 .. Last)); - if Project_Node = Empty_Node then - Project_Node := - Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); - Set_Name_Of (Project_Node, Tree, To => Output_Name_Id); - Set_Project_Declaration_Of - (Project_Node, Tree, - To => Default_Project_Node - (Of_Kind => N_Project_Declaration, In_Tree => Tree)); + if Is_Regular_File + (Dir_Name & Directory_Separator & Str (1 .. Last)) + then + Matched := True; - end if; + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Str (1 .. Last); + File_Name_Id := Name_Find; - -- Create the naming project node, and add an attribute declaration - -- for Source_Files as an empty list, to indicate there are no - -- sources in the naming project. + -- First, check if the file name matches at least one of + -- the excluded expressions; - Project_Naming_Node := - Default_Project_Node (Of_Kind => N_Project, In_Tree => Tree); - Set_Name_Of (Project_Naming_Node, Tree, To => Project_Naming_Id); - Project_Naming_Decl := - Default_Project_Node - (Of_Kind => N_Project_Declaration, In_Tree => Tree); - Set_Project_Declaration_Of - (Project_Naming_Node, Tree, Project_Naming_Decl); - Naming_Package := - Default_Project_Node - (Of_Kind => N_Package_Declaration, In_Tree => Tree); - Set_Name_Of (Naming_Package, Tree, To => Name_Naming); + for Index in Excluded_Patterns'Range loop + if + Match (Canon (1 .. Last), Excluded_Patterns (Index)) + then + Matched := Excluded; + exit; + end if; + end loop; - declare - Decl_Item : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Declarative_Item, In_Tree => Tree); + -- If it does not match any of the excluded expressions, + -- check if the file name matches at least one of the + -- regular expressions. - Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - In_Tree => Tree, - And_Expr_Kind => List); + if Matched = True then + Matched := False; - Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - In_Tree => Tree, - And_Expr_Kind => List); + for Index in Name_Patterns'Range loop + if + Match + (Canon (1 .. Last), Name_Patterns (Index)) + then + Matched := True; + exit; + end if; + end loop; + end if; - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - In_Tree => Tree, - And_Expr_Kind => List); + if Very_Verbose + or else (Matched = True and then Opt.Verbose_Mode) + then + Output.Write_Str (" Checking """); + Output.Write_Str (Str (1 .. Last)); + Output.Write_Line (""": "); + end if; - Empty_List : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String_List, - In_Tree => Tree); + -- If the file name matches one of the regular expressions, + -- parse it to get its unit name. - begin - Set_First_Declarative_Item_Of - (Project_Naming_Decl, Tree, To => Decl_Item); - Set_Next_Declarative_Item (Decl_Item, Tree, Naming_Package); - Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); - Set_Name_Of (Attribute, Tree, To => Name_Source_Files); - Set_Expression_Of (Attribute, Tree, To => Expression); - Set_First_Term (Expression, Tree, To => Term); - Set_Current_Term (Term, Tree, To => Empty_List); - end; + if Matched = True then + declare + FD : File_Descriptor; + Success : Boolean; + Saved_Output : File_Descriptor; + Saved_Error : File_Descriptor; - -- Add a with clause on the naming project in the main project, if - -- there is not already one. + begin + -- If we don't have the path of the compiler yet, + -- get it now. The compiler name may have a prefix, + -- so we get the potentially prefixed name. - declare - With_Clause : Project_Node_Id := - First_With_Clause_Of (Project_Node, Tree); + if Gcc_Path = null then + declare + Prefix_Gcc : String_Access := + Program_Name (Gcc); + begin + Gcc_Path := + Locate_Exec_On_Path (Prefix_Gcc.all); + Free (Prefix_Gcc); + end; - begin - while With_Clause /= Empty_Node loop - exit when - Prj.Tree.Name_Of (With_Clause, Tree) = Project_Naming_Id; - With_Clause := Next_With_Clause_Of (With_Clause, Tree); - end loop; + if Gcc_Path = null then + Prj.Com.Fail ("could not locate " & Gcc); + end if; + end if; - if With_Clause = Empty_Node then - With_Clause := Default_Project_Node - (Of_Kind => N_With_Clause, In_Tree => Tree); - Set_Next_With_Clause_Of - (With_Clause, Tree, - To => First_With_Clause_Of (Project_Node, Tree)); - Set_First_With_Clause_Of - (Project_Node, Tree, To => With_Clause); - Set_Name_Of (With_Clause, Tree, To => Project_Naming_Id); + -- If we don't have yet the file name of the + -- temporary file, get it now. - -- We set the project node to something different than - -- Empty_Node, so that Prj.PP does not generate a limited - -- with clause. + if Temp_File_Name = null then + Create_Temp_File (FD, Temp_File_Name); - Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node); + if FD = Invalid_FD then + Prj.Com.Fail + ("could not create temporary file"); + end if; - Name_Len := Project_Naming_Last; - Name_Buffer (1 .. Name_Len) := - Project_Naming_File_Name (1 .. Project_Naming_Last); - Set_String_Value_Of (With_Clause, Tree, To => Name_Find); - end if; - end; + Close (FD); + Delete_File (Temp_File_Name.all, Success); + end if; - Project_Declaration := Project_Declaration_Of (Project_Node, Tree); + Args (Args'Last) := new String' + (Dir_Name & + Directory_Separator & + Str (1 .. Last)); - -- Add a renaming declaration for package Naming in the main project + -- Create the temporary file - declare - Decl_Item : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Declarative_Item, - In_Tree => Tree); + FD := Create_Output_Text_File + (Name => Temp_File_Name.all); - Naming : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Package_Declaration, - In_Tree => Tree); + if FD = Invalid_FD then + Prj.Com.Fail + ("could not create temporary file"); + end if; - begin - Set_Next_Declarative_Item - (Decl_Item, Tree, - To => First_Declarative_Item_Of (Project_Declaration, Tree)); - Set_First_Declarative_Item_Of - (Project_Declaration, Tree, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, Tree, To => Naming); - Set_Name_Of (Naming, Tree, To => Name_Naming); - Set_Project_Of_Renamed_Package_Of - (Naming, Tree, To => Project_Naming_Node); + -- Save the standard output and error - -- Attach the comments, if any, that were saved for package - -- Naming. + Saved_Output := Dup (Standout); + Saved_Error := Dup (Standerr); - Tree.Project_Nodes.Table (Naming).Comments := - Naming_Package_Comments; - end; + -- Set standard output and error to the temporary file - -- Add an attribute declaration for Source_Dirs, initialized as an - -- empty list. Directories will be added as they are read from the - -- directory list file. + Dup2 (FD, Standout); + Dup2 (FD, Standerr); - declare - Decl_Item : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Declarative_Item, - In_Tree => Tree); + -- And spawn the compiler - Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - In_Tree => Tree, - And_Expr_Kind => List); + Spawn (Gcc_Path.all, Args.all, Success); - Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - In_Tree => Tree, - And_Expr_Kind => List); + -- Restore the standard output and error - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, In_Tree => Tree, - And_Expr_Kind => List); + Dup2 (Saved_Output, Standout); + Dup2 (Saved_Error, Standerr); - begin - Set_Next_Declarative_Item - (Decl_Item, Tree, - To => First_Declarative_Item_Of (Project_Declaration, Tree)); - Set_First_Declarative_Item_Of - (Project_Declaration, Tree, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); - Set_Name_Of (Attribute, Tree, To => Name_Source_Dirs); - Set_Expression_Of (Attribute, Tree, To => Expression); - Set_First_Term (Expression, Tree, To => Term); - Source_Dirs_List := - Default_Project_Node - (Of_Kind => N_Literal_String_List, - In_Tree => Tree, - And_Expr_Kind => List); - Set_Current_Term (Term, Tree, To => Source_Dirs_List); + -- Close the temporary file - -- Attach the comments, if any, that were saved for attribute - -- Source_Dirs. + Close (FD); - Tree.Project_Nodes.Table (Attribute).Comments := - Source_Dirs_Comments; - end; + -- And close the saved standard output and error to + -- avoid too many file descriptors. - -- Add an attribute declaration for Source_List_File with the - -- source list file name that will be created. + Close (Saved_Output); + Close (Saved_Error); - declare - Decl_Item : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Declarative_Item, - In_Tree => Tree); + -- Now that standard output is restored, check if + -- the compiler ran correctly. - Attribute : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Attribute_Declaration, - In_Tree => Tree, - And_Expr_Kind => Single); + -- Read the lines of the temporary file: + -- they should contain the kind and name of the unit. - Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - In_Tree => Tree, - And_Expr_Kind => Single); + declare + File : Text_File; + Text_Line : String (1 .. 1_000); + Text_Last : Natural; - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - In_Tree => Tree, - And_Expr_Kind => Single); + begin + Open (File, Temp_File_Name.all); - Value : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String, - In_Tree => Tree, - And_Expr_Kind => Single); + if not Is_Valid (File) then + Prj.Com.Fail + ("could not read temporary file"); + end if; - begin - Set_Next_Declarative_Item - (Decl_Item, Tree, - To => First_Declarative_Item_Of (Project_Declaration, Tree)); - Set_First_Declarative_Item_Of - (Project_Declaration, Tree, To => Decl_Item); - Set_Current_Item_Node (Decl_Item, Tree, To => Attribute); - Set_Name_Of (Attribute, Tree, To => Name_Source_List_File); - Set_Expression_Of (Attribute, Tree, To => Expression); - Set_First_Term (Expression, Tree, To => Term); - Set_Current_Term (Term, Tree, To => Value); - Name_Len := Source_List_Last; - Name_Buffer (1 .. Name_Len) := - Source_List_Path (1 .. Source_List_Last); - Set_String_Value_Of (Value, Tree, To => Name_Find); + Save_Last_Source_Index := Sources.Last; - -- If there was no comments for attribute Source_List_File, put - -- those for Source_Files, if they exist. + if End_Of_File (File) then + if Opt.Verbose_Mode then + if not Success then + Output.Write_Str (" (process died) "); + end if; + end if; - if Source_List_File_Comments /= Empty_Node then - Tree.Project_Nodes.Table (Attribute).Comments := - Source_List_File_Comments; - else - Tree.Project_Nodes.Table (Attribute).Comments := - Source_Files_Comments; - end if; - end; - end if; + else + Line_Loop : while not End_Of_File (File) loop + Get_Line (File, Text_Line, Text_Last); - -- Process each directory + -- Find the first closing parenthesis - for Index in Directories'Range loop + Char_Loop : for J in 1 .. Text_Last loop + if Text_Line (J) = ')' then + if J >= 13 and then + Text_Line (1 .. 4) = "Unit" + then + -- Add entry to Sources table - declare - Dir_Name : constant String := Directories (Index).all; - Last : Natural := Dir_Name'Last; - Recursively : Boolean := False; + Name_Len := J - 12; + Name_Buffer (1 .. Name_Len) := + Text_Line (6 .. J - 7); + Current_Source := + (Unit_Name => Name_Find, + File_Name => File_Name_Id, + Index => 0, + Spec => Text_Line (J - 5 .. J) = + "(spec)"); - begin - if Dir_Name'Length >= 4 - and then (Dir_Name (Last - 2 .. Last) = "/**") - then - Last := Last - 3; - Recursively := True; - end if; + Sources.Append (Current_Source); + end if; - if Project_File then + exit Char_Loop; + end if; + end loop Char_Loop; + end loop Line_Loop; + end if; - -- Add the directory in the list for attribute Source_Dirs + if Save_Last_Source_Index = Sources.Last then + if Opt.Verbose_Mode then + Output.Write_Line (" not a unit"); + end if; - declare - Expression : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Expression, - In_Tree => Tree, - And_Expr_Kind => Single); - - Term : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Term, - In_Tree => Tree, - And_Expr_Kind => Single); - - Value : constant Project_Node_Id := - Default_Project_Node - (Of_Kind => N_Literal_String, - In_Tree => Tree, - And_Expr_Kind => Single); + else + if Sources.Last > + Save_Last_Source_Index + 1 + then + for Index in Save_Last_Source_Index + 1 .. + Sources.Last + loop + Sources.Table (Index).Index := + Int (Index - Save_Last_Source_Index); + end loop; + end if; - begin - if Current_Source_Dir = Empty_Node then - Set_First_Expression_In_List - (Source_Dirs_List, Tree, To => Expression); - else - Set_Next_Expression_In_List - (Current_Source_Dir, Tree, To => Expression); - end if; + for Index in Save_Last_Source_Index + 1 .. + Sources.Last + loop + Current_Source := Sources.Table (Index); - Current_Source_Dir := Expression; - Set_First_Term (Expression, Tree, To => Term); - Set_Current_Term (Term, Tree, To => Value); - Name_Len := Dir_Name'Length; - Name_Buffer (1 .. Name_Len) := Dir_Name; - Set_String_Value_Of (Value, Tree, To => Name_Find); - end; - end if; + if Opt.Verbose_Mode then + if Current_Source.Spec then + Output.Write_Str (" spec of "); - Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively); - end; + else + Output.Write_Str (" body of "); + end if; - end loop; + Output.Write_Line + (Get_Name_String + (Current_Source.Unit_Name)); + end if; + end loop; + end if; - if Project_File then - Close (Source_List_FD); - end if; + Close (File); - declare - Discard : Boolean; - pragma Warnings (Off, Discard); + Delete_File (Temp_File_Name.all, Success); + end; + end; - begin - -- Delete the file if it already exists + -- File name matches none of the regular expressions - Delete_File - (Path_Name (Directory_Last + 1 .. Path_Last), - Success => Discard); + else + -- If file is not excluded, see if this is foreign source - -- Create a new one + if Matched /= Excluded then + for Index in Foreign_Patterns'Range loop + if Match (Canon (1 .. Last), + Foreign_Patterns (Index)) + then + Matched := True; + exit; + end if; + end loop; + end if; - if Opt.Verbose_Mode then - Output.Write_Str ("Creating new file """); - Output.Write_Str (Path_Name (Directory_Last + 1 .. Path_Last)); - Output.Write_Line (""""); - end if; + if Very_Verbose then + case Matched is + when False => + Output.Write_Line ("no match"); - Output_FD := Create_New_File - (Path_Name (Directory_Last + 1 .. Path_Last), - Fmode => Text); + when Excluded => + Output.Write_Line ("excluded"); - -- Fails if project file cannot be created + when True => + Output.Write_Line ("foreign source"); + end case; + end if; - if Output_FD = Invalid_FD then - Prj.Com.Fail - ("cannot create new """, Path_Name (1 .. Path_Last), """"); - end if; + if Matched = True then - if Project_File then + -- Add source file name without unit name - -- Output the project file + Name_Len := 0; + Add_Str_To_Name_Buffer (Canon (1 .. Last)); + Sources.Append + ((File_Name => Name_Find, + Unit_Name => No_Name, + Index => 0, + Spec => False)); + end if; + end if; + end if; + end loop File_Loop; - Prj.PP.Pretty_Print - (Project_Node, Tree, - W_Char => Write_A_Char'Access, - W_Eol => Write_Eol'Access, - W_Str => Write_A_String'Access, - Backward_Compatibility => False); - Close (Output_FD); + Close (Dir); + end if; - -- Delete the naming project file if it already exists + -- If Recursively is True, call itself for each subdirectory. + -- We do that, even when this directory has already been processed, + -- because all of its subdirectories may not have been processed. - Delete_File - (Project_Naming_File_Name (1 .. Project_Naming_Last), - Success => Discard); + if Recursively then + Open (Dir, Dir_Name); - -- Create a new one + loop + Read (Dir, Str, Last); + exit when Last = 0; - if Opt.Verbose_Mode then - Output.Write_Str ("Creating new naming project file """); - Output.Write_Str (Project_Naming_File_Name - (1 .. Project_Naming_Last)); - Output.Write_Line (""""); - end if; + -- Do not call itself for "." or ".." - Output_FD := Create_New_File - (Project_Naming_File_Name (1 .. Project_Naming_Last), - Fmode => Text); + if Is_Directory + (Dir_Name & Directory_Separator & Str (1 .. Last)) + and then Str (1 .. Last) /= "." + and then Str (1 .. Last) /= ".." + then + Process_Directory + (Dir_Name & Directory_Separator & Str (1 .. Last), + Recursively => True); + end if; + end loop; - -- Fails if naming project file cannot be created + Close (Dir); + end if; + end Process_Directory; - if Output_FD = Invalid_FD then - Prj.Com.Fail - ("cannot create new """, - Project_Naming_File_Name (1 .. Project_Naming_Last), - """"); - end if; + -- Start of processing for Process - -- Output the naming project file + begin + Processed_Directories.Set_Last (0); - Prj.PP.Pretty_Print - (Project_Naming_Node, Tree, - W_Char => Write_A_Char'Access, - W_Eol => Write_Eol'Access, - W_Str => Write_A_String'Access, - Backward_Compatibility => False); - Close (Output_FD); + -- Process each directory - else - -- Write to the output file each entry in the SFN_Pragmas table - -- as an pragma Source_File_Name. + for Index in Directories'Range loop - for Index in 1 .. SFN_Pragmas.Last loop - Write_A_String ("pragma Source_File_Name"); - Write_Eol; - Write_A_String (" ("); - Write_A_String - (Get_Name_String (SFN_Pragmas.Table (Index).Unit)); - Write_A_String (","); - Write_Eol; + declare + Dir_Name : constant String := Directories (Index).all; + Last : Natural := Dir_Name'Last; + Recursively : Boolean := False; + Found : Boolean; + Canonical : String (1 .. Dir_Name'Length) := Dir_Name; - if SFN_Pragmas.Table (Index).Spec then - Write_A_String (" Spec_File_Name => """); + begin + Canonical_Case_File_Name (Canonical); - else - Write_A_String (" Body_File_Name => """); + Found := False; + for J in 1 .. Source_Directories.Last loop + if Source_Directories.Table (J).all = Canonical then + Found := True; + exit; end if; + end loop; - Write_A_String - (Get_Name_String (SFN_Pragmas.Table (Index).File)); - - Write_A_String (""""); - - if SFN_Pragmas.Table (Index).Index /= 0 then - Write_A_String (", Index =>"); - Write_A_String (SFN_Pragmas.Table (Index).Index'Img); - end if; + if not Found then + Source_Directories.Append (new String'(Canonical)); + end if; - Write_A_String (");"); - Write_Eol; - end loop; + if Dir_Name'Length >= 4 + and then (Dir_Name (Last - 2 .. Last) = "/**") + then + Last := Last - 3; + Recursively := True; + end if; - Close (Output_FD); - end if; - end; + Process_Directory (Dir_Name (Dir_Name'First .. Last), Recursively); + end; - end Make; + end loop; + end Process; ---------------- -- Write_Char -- |