diff options
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 -- |