-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
------------------------------------------------------------------------------
with Csets;
-with Namet; use Namet;
with Opt;
with Output;
with Osint; use Osint;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.Regexp; use GNAT.Regexp;
with System.Case_Util; use System.Case_Util;
with System.CRTL;
-- 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);
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 --
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;
+ --------------
+ -- Finalize --
+ --------------
- Path_Name : String (1 .. File_Path'Length +
- Project_File_Extension'Length);
- Path_Last : Natural := File_Path'Length;
+ procedure Finalize is
+ Discard : Boolean;
+ pragma Warnings (Off, Discard);
- Directory_Last : Natural := 0;
+ Current_Source_Dir : Project_Node_Id := Empty_Node;
- Output_Name : String (Path_Name'Range);
- Output_Name_Last : Natural;
- Output_Name_Id : Name_Id;
+ 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.
- 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;
+ 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));
- 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;
+ end if;
- 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;
+ end if;
- Project_Naming_File_Name : String (1 .. Output_Name'Length +
- Naming_File_Suffix'Length);
+ -- Delete the file if it already exists
- Project_Naming_Last : Natural;
- Project_Naming_Id : Name_Id := No_Name;
+ Delete_File
+ (Path_Name (Directory_Last + 1 .. Path_Last),
+ Success => Discard);
- Excluded_Expressions : array (Excluded_Patterns'Range) of Regexp;
- Regular_Expressions : array (Name_Patterns'Range) of Regexp;
- Foreign_Expressions : array (Foreign_Patterns'Range) of Regexp;
+ -- Create a new one
- Source_List_Path : String (1 .. Output_Name'Length +
- Source_List_File_Suffix'Length);
- Source_List_Last : Natural;
+ 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;
- Source_List_FD : File_Descriptor;
+ Output_FD := Create_New_File
+ (Path_Name (Directory_Last + 1 .. Path_Last),
+ Fmode => Text);
- Args : Argument_List (1 .. Preproc_Switches'Length + 6);
+ -- Fails if project file cannot be created
- type SFN_Pragma is record
- Unit : Name_Id;
- File : Name_Id;
- Index : Int := 0;
- Spec : Boolean;
- end record;
+ if Output_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create new """ & Path_Name (1 .. Path_Last) & """");
+ end if;
- 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");
+ if Project_File then
- 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.
+ -- Delete the source list file, if it already exists
- -----------------------
- -- Process_Directory --
- -----------------------
+ declare
+ Discard : Boolean;
+ pragma Warnings (Off, Discard);
+ begin
+ Delete_File
+ (Source_List_Path (1 .. Source_List_Last),
+ Success => Discard);
+ end;
- 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;
+ -- And create a new source list file, fail if 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;
+ Source_List_FD := Create_New_File
+ (Name => Source_List_Path (1 .. Source_List_Last),
+ Fmode => Text);
- begin
- -- Avoid processing the same directory more than once
+ if Source_List_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create file """
+ & Source_List_Path (1 .. Source_List_Last)
+ & """");
+ end if;
- for Index in 1 .. Processed_Directories.Last loop
- if Processed_Directories.Table (Index).all = Dir_Name then
- Process := False;
- exit;
- end if;
- end loop;
+ 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;
- if Process then
- if Opt.Verbose_Mode then
- Output.Write_Str ("Processing directory """);
- Output.Write_Str (Dir_Name);
- Output.Write_Line ("""");
- end if;
+ -- Create the naming project node
- Processed_Directories. Increment_Last;
- Processed_Directories.Table (Processed_Directories.Last) :=
- new String'(Dir_Name);
+ 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);
- -- Get the source file names from the directory. Fails if the
- -- directory does not exist.
+ -- 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).
- begin
- Open (Dir, Dir_Name);
- exception
- when Directory_Error =>
- Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
- end;
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item, In_Tree => Tree);
- -- Process each regular file in the directory
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- File_Loop : loop
- Read (Dir, Str, Last);
- exit File_Loop when Last = 0;
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- -- Copy the file name and put it in canonical case to match
- -- against the patterns that have themselves already been put
- -- in canonical case.
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- Canon (1 .. Last) := Str (1 .. Last);
- Canonical_Case_File_Name (Canon (1 .. Last));
+ Empty_List : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String_List,
+ In_Tree => Tree);
- if Is_Regular_File
- (Dir_Name & Directory_Separator & Str (1 .. Last))
- then
- Matched := True;
+ 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;
- Name_Len := Last;
- Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
- File_Name_Id := Name_Find;
+ -- Add a with clause on the naming project in the main project, if
+ -- there is not already one.
- -- First, check if the file name matches at least one of
- -- the excluded expressions;
+ declare
+ With_Clause : Project_Node_Id :=
+ First_With_Clause_Of (Project_Node, Tree);
- for Index in Excluded_Expressions'Range loop
- if
- Match (Canon (1 .. Last), Excluded_Expressions (Index))
- then
- Matched := Excluded;
- exit;
- end if;
- end loop;
+ 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 it does not match any of the excluded expressions,
- -- check if the file name matches at least one of the
- -- regular expressions.
+ 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);
- if Matched = True then
- Matched := False;
+ -- We set the project node to something different than
+ -- Empty_Node, so that Prj.PP does not generate a limited
+ -- with clause.
- 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;
+ Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
- 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;
+ 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 the file name matches one of the regular expressions,
- -- parse it to get its unit name.
+ Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
- if Matched = True then
- declare
- FD : File_Descriptor;
- Success : Boolean;
- Saved_Output : File_Descriptor;
- Saved_Error : File_Descriptor;
+ -- Add a package Naming in the main project, that is a renaming of
+ -- package Naming in the naming project.
- 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
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => 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;
+ Naming : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Package_Declaration,
+ In_Tree => Tree);
- if Gcc_Path = null then
- Prj.Com.Fail ("could not locate " & Gcc);
- end if;
- end if;
-
- -- If we don't have yet the file name of the
- -- temporary file, get it now.
+ 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);
- if Temp_File_Name = null then
- Create_Temp_File (FD, Temp_File_Name);
+ -- Attach the comments, if any, that were saved for package
+ -- Naming.
- if FD = Invalid_FD then
- Prj.Com.Fail
- ("could not create temporary file");
- end if;
+ Tree.Project_Nodes.Table (Naming).Comments :=
+ Naming_Package_Comments;
+ end;
- Close (FD);
- Delete_File (Temp_File_Name.all, Success);
- end if;
+ -- Add an attribute declaration for Source_Dirs, initialized as an
+ -- empty list.
- Args (Args'Last) := new String'
- (Dir_Name &
- Directory_Separator &
- Str (1 .. Last));
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
- -- Create the temporary file
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- FD := Create_Output_Text_File
- (Name => Temp_File_Name.all);
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- if FD = Invalid_FD then
- Prj.Com.Fail
- ("could not create temporary file");
- end if;
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term, In_Tree => Tree,
+ And_Expr_Kind => List);
- -- Save the standard output and error
+ 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);
- Saved_Output := Dup (Standout);
- Saved_Error := Dup (Standerr);
+ -- Attach the comments, if any, that were saved for attribute
+ -- Source_Dirs.
- -- Set standard output and error to the temporary file
+ Tree.Project_Nodes.Table (Attribute).Comments :=
+ Source_Dirs_Comments;
+ end;
- Dup2 (FD, Standout);
- Dup2 (FD, Standerr);
+ -- Put the source directories in attribute Source_Dirs
- -- And spawn the compiler
+ 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);
- Spawn (Gcc_Path.all, Args, Success);
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Restore the standard output and error
+ Value : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- Dup2 (Saved_Output, Standout);
- Dup2 (Saved_Error, Standerr);
+ 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;
- -- Close the temporary file
+ 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;
- Close (FD);
+ -- Add an attribute declaration for Source_Files or Source_List_File
+ -- with the source list file name that will be created.
- -- And close the saved standard output and error to
- -- avoid too many file descriptors.
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
- Close (Saved_Output);
- Close (Saved_Error);
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Now that standard output is restored, check if
- -- the compiler ran correctly.
+ Expression : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- -- Read the lines of the temporary file:
- -- they should contain the kind and name of the unit.
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- declare
- File : Text_File;
- Text_Line : String (1 .. 1_000);
- Text_Last : Natural;
+ Value : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Literal_String,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
- begin
- Open (File, Temp_File_Name.all);
+ 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);
- if not Is_Valid (File) then
- Prj.Com.Fail
- ("could not read temporary file");
- end if;
+ 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_Pragma_Index := SFN_Pragmas.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 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;
- else
- Line_Loop : while not End_Of_File (File) loop
- Get_Line (File, Text_Line, Text_Last);
+ -- Put the sources in the source list files and in the naming
+ -- project.
- -- Find the first closing parenthesis
+ for Source_Index in 1 .. Sources.Last 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 SFN_Pragmas table
+ -- Add the corresponding attribute in the
+ -- Naming package of the naming project.
- 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)");
+ declare
+ Current_Source : constant Source :=
+ Sources.Table (Source_Index);
- 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;
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind =>
+ N_Declarative_Item,
+ In_Tree => Tree);
- if Save_Last_Pragma_Index = SFN_Pragmas.Last then
- if Opt.Verbose_Mode then
- Output.Write_Line (" not a unit");
- 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);
- 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;
+ begin
+ -- Add source file name to the source list file
- for Index in Save_Last_Pragma_Index + 1 ..
- SFN_Pragmas.Last
- loop
- SFN_Prag := SFN_Pragmas.Table (Index);
+ 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;
- if Opt.Verbose_Mode then
- if SFN_Prag.Spec then
- Output.Write_Str (" spec of ");
+ -- 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;
- else
- Output.Write_Str (" body of ");
- end if;
+ -- Get the name of the unit
- Output.Write_Line
- (Get_Name_String (SFN_Prag.Unit));
- 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);
- if Project_File then
+ Set_Expression_Of
+ (Attribute, Tree, To => Expression);
+ Set_First_Term
+ (Expression, Tree, To => Term);
+ Set_Current_Term
+ (Term, Tree, To => Value);
- -- Add the corresponding attribute in the
- -- Naming package of the naming project.
+ -- And set the name of the file
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind =>
- N_Declarative_Item,
- In_Tree => Tree);
+ 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;
- 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;
+ -- Close the source list file
- -- Get the name of the unit
+ Close (Source_List_FD);
- Get_Name_String (SFN_Prag.Unit);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Set_Associative_Array_Index_Of
- (Attribute, Tree, To => Name_Find);
+ -- Output the project file
- Set_Expression_Of
- (Attribute, Tree, To => Expression);
- Set_First_Term
- (Expression, Tree, To => Term);
- Set_Current_Term
- (Term, Tree, To => Value);
+ 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);
- -- And set the name of the file
+ -- Delete the naming project file if it already exists
- 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;
+ Delete_File
+ (Project_Naming_File_Name (1 .. Project_Naming_Last),
+ Success => Discard);
- if Project_File then
- -- Add source file name to source list
- -- file.
+ -- Create a new one
- Last := Last + 1;
- Str (Last) := ASCII.LF;
+ 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;
- if Write (Source_List_FD,
- Str (1)'Address,
- Last) /= Last
- then
- Prj.Com.Fail ("disk full");
- end if;
- end if;
- end if;
+ Output_FD := Create_New_File
+ (Project_Naming_File_Name (1 .. Project_Naming_Last),
+ Fmode => Text);
- Close (File);
+ -- Fails if naming project file cannot be created
- Delete_File (Temp_File_Name.all, Success);
- end;
- end;
+ if Output_FD = Invalid_FD then
+ Prj.Com.Fail
+ ("cannot create new """
+ & Project_Naming_File_Name (1 .. Project_Naming_Last)
+ & """");
+ end if;
- -- File name matches none of the regular expressions
+ -- Output the naming project file
- else
- -- If file is not excluded, see if this is foreign source
+ 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 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;
+ else
+ -- For each Ada source, write a pragma Source_File_Name to the
+ -- configuration pragmas file.
- if Very_Verbose then
- case Matched is
- when False =>
- Output.Write_Line ("no match");
-
- when Excluded =>
- Output.Write_Line ("excluded");
-
- when True =>
- Output.Write_Line ("foreign source");
- end case;
- end if;
-
- if Project_File and Matched = True then
-
- -- 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;
+
+ Close (Output_FD);
+ end if;
+ end Finalize;
- -- Start of processing for Make
+ ----------------
+ -- 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;
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");
-- 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
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.
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,
+ Is_Config_File => False,
+ Current_Directory => Get_Current_Dir,
Packages_To_Check => Packages_To_Check_By_Gnatname);
-- 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
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));
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);
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,
-- 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;
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
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,
exception
when Directory_Error =>
Prj.Com.Fail
- ("unknown directory """,
- Path_Name (1 .. Directory_Last),
- """");
+ ("unknown directory """
+ & Path_Name (1 .. Directory_Last)
+ & """");
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
+ -----------------------
+ -- Process_Directory --
+ -----------------------
- declare
- Discard : Boolean;
- begin
- Delete_File
- (Source_List_Path (1 .. Source_List_Last),
- Success => Discard);
- end;
+ 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;
- -- And create a new source list file.
- -- Fail if file cannot be created.
+ Temp_File_Name : String_Access := null;
+ Save_Last_Source_Index : Natural := 0;
+ File_Name_Id : Name_Id := No_Name;
- Source_List_FD := Create_New_File
- (Name => Source_List_Path (1 .. Source_List_Last),
- Fmode => Text);
+ Current_Source : Source;
- if Source_List_FD = Invalid_FD then
- Prj.Com.Fail
- ("cannot create file """,
- Source_List_Path (1 .. Source_List_Last),
- """");
- end if;
- end if;
+ begin
+ -- Avoid processing the same directory more than once
- -- Compile the regular expressions. Fails immediately if any of
- -- the specified strings is in error.
+ 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;
- 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;
+ if Do_Process then
+ if Opt.Verbose_Mode then
+ Output.Write_Str ("Processing directory """);
+ Output.Write_Str (Dir_Name);
+ Output.Write_Line ("""");
+ end if;
- 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;
+ Processed_Directories. Increment_Last;
+ Processed_Directories.Table (Processed_Directories.Last) :=
+ new String'(Dir_Name);
- 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;
+ -- Get the source file names from the directory. Fails if the
+ -- directory does not exist.
- 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;
+ begin
+ Open (Dir, Dir_Name);
+ exception
+ when Directory_Error =>
+ Prj.Com.Fail ("cannot open directory """ & Dir_Name & """");
+ end;
- 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;
+ -- Process each regular file in the directory
- begin
- Regular_Expressions (Index) :=
- Compile (Pattern => Name_Patterns (Index).all, Glob => True);
+ File_Loop : loop
+ Read (Dir, Str, Last);
+ exit File_Loop when Last = 0;
- exception
- when Error_In_Regexp =>
- Prj.Com.Fail
- ("invalid regular expression """,
- Name_Patterns (Index).all,
- """");
- end;
- end loop;
+ -- 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 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;
+ Canon (1 .. Last) := Str (1 .. Last);
+ Canonical_Case_File_Name (Canon (1 .. Last));
- -- 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.
+ if Is_Regular_File
+ (Dir_Name & Directory_Separator & Str (1 .. Last))
+ then
+ Matched := True;
- 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));
+ Name_Len := Last;
+ Name_Buffer (1 .. Name_Len) := Str (1 .. Last);
+ File_Name_Id := Name_Find;
- end if;
+ -- First, check if the file name matches at least one of
+ -- the excluded expressions;
- -- 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.
+ for Index in Excluded_Patterns'Range loop
+ if
+ Match (Canon (1 .. Last), Excluded_Patterns (Index))
+ then
+ Matched := Excluded;
+ exit;
+ end if;
+ end loop;
- 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);
+ -- If it does not match any of the excluded expressions,
+ -- check if the file name matches at least one of the
+ -- regular expressions.
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item, In_Tree => Tree);
+ if Matched = True then
+ Matched := False;
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- 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;
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- 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;
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ -- If the file name matches one of the regular expressions,
+ -- parse it to get its unit name.
- Empty_List : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String_List,
- In_Tree => Tree);
+ if Matched = True then
+ declare
+ FD : File_Descriptor;
+ Success : Boolean;
+ Saved_Output : File_Descriptor;
+ Saved_Error : File_Descriptor;
- 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;
+ 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.
- -- Add a with clause on the naming project in the main project, if
- -- there is not already one.
+ if Gcc_Path = null then
+ declare
+ Prefix_Gcc : String_Access :=
+ Program_Name (Gcc, "gnatname");
+ begin
+ Gcc_Path :=
+ Locate_Exec_On_Path (Prefix_Gcc.all);
+ Free (Prefix_Gcc);
+ end;
- declare
- With_Clause : Project_Node_Id :=
- First_With_Clause_Of (Project_Node, Tree);
+ if Gcc_Path = null then
+ Prj.Com.Fail ("could not locate " & Gcc);
+ end if;
+ end if;
- 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 we don't have yet the file name of the
+ -- temporary file, get it now.
- 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 Temp_File_Name = null then
+ Create_Temp_File (FD, Temp_File_Name);
- -- We set the project node to something different than
- -- Empty_Node, so that Prj.PP does not generate a limited
- -- with clause.
+ if FD = Invalid_FD then
+ Prj.Com.Fail
+ ("could not create temporary file");
+ end if;
- Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
+ Close (FD);
+ Delete_File (Temp_File_Name.all, Success);
+ 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;
+ Args (Args'Last) := new String'
+ (Dir_Name &
+ Directory_Separator &
+ Str (1 .. Last));
- Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
+ -- Create the temporary file
- -- Add a renaming declaration for package Naming in the main project
+ FD := Create_Output_Text_File
+ (Name => Temp_File_Name.all);
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ if FD = Invalid_FD then
+ Prj.Com.Fail
+ ("could not create temporary file");
+ end if;
- Naming : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Package_Declaration,
- In_Tree => Tree);
+ -- Save the standard output and error
- 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);
+ Saved_Output := Dup (Standout);
+ Saved_Error := Dup (Standerr);
- -- Attach the comments, if any, that were saved for package
- -- Naming.
+ -- Set standard output and error to the temporary file
- Tree.Project_Nodes.Table (Naming).Comments :=
- Naming_Package_Comments;
- end;
+ Dup2 (FD, Standout);
+ Dup2 (FD, Standerr);
- -- 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.
+ -- And spawn the compiler
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ Spawn (Gcc_Path.all, Args.all, Success);
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ -- Restore the standard output and error
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => List);
+ Dup2 (Saved_Output, Standout);
+ Dup2 (Saved_Error, Standerr);
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term, In_Tree => Tree,
- And_Expr_Kind => List);
+ -- Close the temporary file
- 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 (FD);
- -- Attach the comments, if any, that were saved for attribute
- -- Source_Dirs.
+ -- And close the saved standard output and error to
+ -- avoid too many file descriptors.
- Tree.Project_Nodes.Table (Attribute).Comments :=
- Source_Dirs_Comments;
- end;
+ Close (Saved_Output);
+ Close (Saved_Error);
- -- Add an attribute declaration for Source_List_File with the
- -- source list file name that will be created.
+ -- Now that standard output is restored, check if
+ -- the compiler ran correctly.
- declare
- Decl_Item : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Declarative_Item,
- In_Tree => Tree);
+ -- Read the lines of the temporary file:
+ -- they should contain the kind and name of the unit.
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ declare
+ File : Text_File;
+ Text_Line : String (1 .. 1_000);
+ Text_Last : Natural;
- Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ begin
+ Open (File, Temp_File_Name.all);
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ if not Is_Valid (File) then
+ Prj.Com.Fail
+ ("could not read temporary file");
+ end if;
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- In_Tree => Tree,
- And_Expr_Kind => Single);
+ Save_Last_Source_Index := Sources.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);
- 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);
-
- -- 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;
+ 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 --
OSDN Git Service
