-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005 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- --
with GNAT.Regexp; use GNAT.Regexp;
with System.Case_Util; use System.Case_Util;
+with System.CRTL;
package body Prj.Makr is
function Dup (Fd : File_Descriptor) return File_Descriptor;
- pragma Import (C, Dup);
procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
- pragma Import (C, Dup2);
Gcc : constant String := "gcc";
Gcc_Path : String_Access := null;
Naming_File_Suffix : constant String := "_naming";
Source_List_File_Suffix : constant String := "_source_list.txt";
- Output_FD : File_Descriptor;
- -- To save the project file and its naming project file.
+ Output_FD : File_Descriptor;
+ -- To save the project file and its naming project file
procedure Write_Eol;
- -- Output an empty line.
+ -- Output an empty line
procedure Write_A_Char (C : Character);
-- Write one character to Output_FD
Table_Increment => 10,
Table_Name => "Prj.Makr.Processed_Directories");
+ ---------
+ -- Dup --
+ ---------
+
+ function Dup (Fd : File_Descriptor) return File_Descriptor is
+ begin
+ return File_Descriptor (System.CRTL.dup (Integer (Fd)));
+ end Dup;
+
+ ----------
+ -- Dup2 --
+ ----------
+
+ procedure Dup2 (Old_Fd, New_Fd : File_Descriptor) is
+ Fd : Integer;
+ pragma Warnings (Off, Fd);
+ begin
+ Fd := System.CRTL.dup2 (Integer (Old_Fd), Integer (New_Fd));
+ end Dup2;
+
----------
-- Make --
----------
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;
Args : Argument_List (1 .. Preproc_Switches'Length + 6);
type SFN_Pragma is record
- Unit : Name_Id;
- File : Name_Id;
- Spec : Boolean;
+ Unit : Name_Id;
+ File : Name_Id;
+ Index : Int := 0;
+ Spec : Boolean;
end record;
package SFN_Pragmas is new Table.Table
-----------------------
procedure Process_Directory (Dir_Name : String; Recursively : Boolean) is
- Matched : Matched_Type := False;
- Str : String (1 .. 2_000);
- Last : Natural;
- Dir : Dir_Type;
- Process : Boolean := True;
-
- Temp_File_Name : String_Access := null;
-
+ Matched : Matched_Type := False;
+ Str : String (1 .. 2_000);
+ Canon : String (1 .. 2_000);
+ Last : Natural;
+ Dir : Dir_Type;
+ Process : Boolean := True;
+
+ Temp_File_Name : String_Access := null;
Save_Last_Pragma_Index : Natural := 0;
-
- File_Name_Id : Name_Id := No_Name;
-
- SFN_Prag : SFN_Pragma;
+ File_Name_Id : Name_Id := No_Name;
+ SFN_Prag : SFN_Pragma;
begin
-- Avoid processing the same directory more than once
Processed_Directories.Table (Processed_Directories.Last) :=
new String'(Dir_Name);
- -- Get the source file names from the directory.
- -- Fails if the directory does not exist.
+ -- Get the source file names from the directory. Fails if the
+ -- directory does not exist.
begin
Open (Dir, Dir_Name);
-
exception
when Directory_Error =>
Prj.Com.Fail ("cannot open directory """, Dir_Name, """");
Read (Dir, Str, Last);
exit File_Loop when Last = 0;
+ -- Copy the file name and put it in canonical case to match
+ -- against the patterns that have themselves already been put
+ -- in canonical case.
+
+ Canon (1 .. Last) := Str (1 .. Last);
+ Canonical_Case_File_Name (Canon (1 .. Last));
+
if Is_Regular_File
(Dir_Name & Directory_Separator & Str (1 .. Last))
then
for Index in Excluded_Expressions'Range loop
if
- Match (Str (1 .. Last), Excluded_Expressions (Index))
+ Match (Canon (1 .. Last), Excluded_Expressions (Index))
then
Matched := Excluded;
exit;
for Index in Regular_Expressions'Range loop
if
- Match (Str (1 .. Last), Regular_Expressions (Index))
+ Match
+ (Canon (1 .. Last), Regular_Expressions (Index))
then
Matched := True;
exit;
then
Output.Write_Str (" Checking """);
Output.Write_Str (Str (1 .. Last));
- Output.Write_Str (""": ");
+ Output.Write_Line (""": ");
end if;
-- If the file name matches one of the regular expressions,
begin
-- If we don't have the path of the compiler yet,
- -- get it now.
+ -- get it now. The compiler name may have a prefix,
+ -- so we get the potentially prefixed name.
if Gcc_Path = null then
- Gcc_Path := Locate_Exec_On_Path (Gcc);
+ declare
+ Prefix_Gcc : String_Access :=
+ Program_Name (Gcc);
+ begin
+ Gcc_Path :=
+ Locate_Exec_On_Path (Prefix_Gcc.all);
+ Free (Prefix_Gcc);
+ end;
if Gcc_Path = null then
Prj.Com.Fail ("could not locate " & Gcc);
if End_Of_File (File) then
if Opt.Verbose_Mode then
if not Success then
- Output.Write_Str ("(process died) ");
+ Output.Write_Str (" (process died) ");
end if;
end if;
+
else
Line_Loop : while not End_Of_File (File) loop
Get_Line (File, Text_Line, Text_Last);
if J >= 13 and then
Text_Line (1 .. 4) = "Unit"
then
- -- Add an entry in the SFN_Pragmas
- -- table.
+ -- Add entry to SFN_Pragmas table
Name_Len := J - 12;
Name_Buffer (1 .. Name_Len) :=
Text_Line (6 .. J - 7);
SFN_Prag :=
- (Unit => Name_Find,
- File => File_Name_Id,
- Spec => Text_Line (J - 5 .. J) =
- "(spec)");
+ (Unit => Name_Find,
+ File => File_Name_Id,
+ Index => 0,
+ Spec => Text_Line (J - 5 .. J) =
+ "(spec)");
SFN_Pragmas.Increment_Last;
SFN_Pragmas.Table
if Save_Last_Pragma_Index = SFN_Pragmas.Last then
if Opt.Verbose_Mode then
- Output.Write_Line ("not a unit");
- end if;
-
- elsif SFN_Pragmas.Last >
- Save_Last_Pragma_Index + 1
- then
- SFN_Pragmas.Set_Last (Save_Last_Pragma_Index);
-
- if Opt.Verbose_Mode then
- Output.Write_Line
- ("file contains multiple units");
+ Output.Write_Line (" not a unit");
end if;
else
- SFN_Prag := SFN_Pragmas.Table
- (SFN_Pragmas.Last);
-
- if Opt.Verbose_Mode then
- if SFN_Prag.Spec then
- Output.Write_Str ("spec of ");
-
- else
- Output.Write_Str ("body of ");
- end if;
-
- Output.Write_Line
- (Get_Name_String (SFN_Prag.Unit));
+ 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;
- if Project_File then
-
- -- Add the corresponding attribute in
- -- the Naming package of the naming
- -- project.
-
- declare
- Decl_Item : constant Project_Node_Id
- := Default_Project_Node
- (Of_Kind =>
- N_Declarative_Item);
-
- Attribute : constant Project_Node_Id
- := Default_Project_Node
- (Of_Kind =>
- N_Attribute_Declaration);
-
- Expression : constant Project_Node_Id
- := Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => Single);
-
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- And_Expr_Kind => Single);
-
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind =>
- N_Literal_String,
- And_Expr_Kind =>
- Single);
-
- begin
- Set_Next_Declarative_Item
- (Decl_Item,
- To => First_Declarative_Item_Of
- (Naming_Package));
- Set_First_Declarative_Item_Of
- (Naming_Package, To => Decl_Item);
- Set_Current_Item_Node
- (Decl_Item, To => Attribute);
-
- -- Is it a spec or a body?
+ for Index in Save_Last_Pragma_Index + 1 ..
+ SFN_Pragmas.Last
+ loop
+ SFN_Prag := SFN_Pragmas.Table (Index);
+ if Opt.Verbose_Mode then
if SFN_Prag.Spec then
- Set_Name_Of
- (Attribute, To => Name_Spec);
+ Output.Write_Str (" spec of ");
+
else
- Set_Name_Of
- (Attribute,
- To => Name_Body);
+ 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 (SFN_Prag.Unit);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Set_Associative_Array_Index_Of
- (Attribute, To => Name_Find);
+ if Project_File then
+
+ -- Add the corresponding attribute in the
+ -- Naming package of the naming project.
+
+ declare
+ Decl_Item : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind =>
+ N_Declarative_Item,
+ In_Tree => Tree);
+
+ 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 the name of the unit
+
+ Get_Name_String (SFN_Prag.Unit);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Set_Associative_Array_Index_Of
+ (Attribute, Tree, To => Name_Find);
- Set_Expression_Of
- (Attribute, To => Expression);
- Set_First_Term
- (Expression, To => Term);
- Set_Current_Term (Term, To => Value);
+ Set_Expression_Of
+ (Attribute, Tree, To => Expression);
+ Set_First_Term
+ (Expression, Tree, To => Term);
+ Set_Current_Term
+ (Term, Tree, To => Value);
- -- And set the name of the file
+ -- And set the name of the file
- Set_String_Value_Of
- (Value, To => File_Name_Id);
- end;
+ 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;
+ if Project_File then
-- Add source file name to source list
-- file.
-- File name matches none of the regular expressions
else
- -- If the file is not excluded, look if this is a foreign
- -- source.
+ -- If file is not excluded, see if this is foreign source
if Matched /= Excluded then
for Index in Foreign_Expressions'Range loop
- if Match (Str (1 .. Last),
+ if Match (Canon (1 .. Last),
Foreign_Expressions (Index))
then
Matched := True;
Csets.Initialize;
Namet.Initialize;
Snames.Initialize;
- Prj.Initialize;
+ Prj.Initialize (No_Project_Tree);
+ Prj.Tree.Initialize (Tree);
SFN_Pragmas.Set_Last (0);
Output_Name (1 .. Path_Last) := To_Lower (Path_Name (1 .. Path_Last));
Output_Name_Last := Path_Last - Project_File_Extension'Length;
+ -- 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_Line ("""");
+ end if;
+
+ Part.Parse
+ (In_Tree => Tree,
+ Project => Project_Node,
+ Project_File_Name => Output_Name (1 .. Output_Name_Last),
+ Always_Errout_Finalize => False);
+
+ -- Fail if parsing was not successful
+
+ if Project_Node = Empty_Node then
+ Fail ("parsing of existing project file failed");
+
+ else
+ -- If parsing was successful, remove the components that are
+ -- automatically generated, if any, so that they will be
+ -- unconditionally added later.
+
+ -- Remove the with clause for the naming project file
+
+ declare
+ With_Clause : Project_Node_Id :=
+ First_With_Clause_Of (Project_Node, Tree);
+ Previous : Project_Node_Id := Empty_Node;
+
+ begin
+ while With_Clause /= Empty_Node loop
+ if Prj.Tree.Name_Of (With_Clause, Tree) =
+ Project_Naming_Id
+ then
+ if Previous = Empty_Node then
+ Set_First_With_Clause_Of
+ (Project_Node, Tree,
+ To => Next_With_Clause_Of (With_Clause, Tree));
+ else
+ Set_Next_With_Clause_Of
+ (Previous, Tree,
+ To => Next_With_Clause_Of (With_Clause, Tree));
+ end if;
+
+ exit;
+ end if;
+
+ Previous := With_Clause;
+ With_Clause := Next_With_Clause_Of (With_Clause, Tree);
+ end loop;
+ end;
+
+ -- Remove attribute declarations of Source_Files,
+ -- Source_List_File, Source_Dirs, and the declaration of
+ -- package Naming, if they exist.
+
+ declare
+ Declaration : Project_Node_Id :=
+ First_Declarative_Item_Of
+ (Project_Declaration_Of
+ (Project_Node, Tree),
+ Tree);
+ Previous : Project_Node_Id := Empty_Node;
+ Current_Node : Project_Node_Id := Empty_Node;
+
+ begin
+ while Declaration /= Empty_Node loop
+ Current_Node := Current_Item_Node (Declaration, Tree);
+
+ if (Kind_Of (Current_Node, Tree) = N_Attribute_Declaration
+ and then
+ (Prj.Tree.Name_Of (Current_Node, Tree) =
+ Name_Source_Files
+ or else Prj.Tree.Name_Of (Current_Node, Tree) =
+ Name_Source_List_File
+ or else Prj.Tree.Name_Of (Current_Node, Tree) =
+ Name_Source_Dirs))
+ or else
+ (Kind_Of (Current_Node, Tree) = N_Package_Declaration
+ and then Prj.Tree.Name_Of (Current_Node, Tree) =
+ Name_Naming)
+ then
+ if Previous = Empty_Node then
+ Set_First_Declarative_Item_Of
+ (Project_Declaration_Of (Project_Node, Tree),
+ Tree,
+ To => Next_Declarative_Item (Declaration, Tree));
+
+ else
+ Set_Next_Declarative_Item
+ (Previous, Tree,
+ To => Next_Declarative_Item (Declaration, Tree));
+ end if;
+
+ else
+ Previous := Declaration;
+ end if;
+
+ Declaration := Next_Declarative_Item (Declaration, Tree);
+ end loop;
+ end;
+ end if;
+ end if;
+
if Directory_Last /= 0 then
Output_Name (1 .. Output_Name_Last - Directory_Last) :=
Output_Name (Directory_Last + 1 .. Output_Name_Last);
Output.Write_Line ("""");
end if;
- -- 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 .. Output_Name_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_Line ("""");
- end if;
-
- Part.Parse
- (Project => Project_Node,
- Project_File_Name => Output_Name (1 .. Output_Name_Last),
- Always_Errout_Finalize => False);
-
- -- If parsing was successful, remove the components that are
- -- automatically generated, if any, so that they will be
- -- unconditionally added later.
-
- if Project_Node /= Empty_Node then
-
- -- Remove the with clause for the naming project file
-
- declare
- With_Clause : Project_Node_Id :=
- First_With_Clause_Of (Project_Node);
- Previous : Project_Node_Id := Empty_Node;
-
- begin
- while With_Clause /= Empty_Node loop
- if Tree.Name_Of (With_Clause) = Project_Naming_Id then
- if Previous = Empty_Node then
- Set_First_With_Clause_Of
- (Project_Node,
- To => Next_With_Clause_Of (With_Clause));
- else
- Set_Next_With_Clause_Of
- (Previous,
- To => Next_With_Clause_Of (With_Clause));
- end if;
-
- exit;
- end if;
-
- Previous := With_Clause;
- With_Clause := Next_With_Clause_Of (With_Clause);
- end loop;
- end;
-
- -- Remove attribute declarations of Source_Files,
- -- Source_List_File, Source_Dirs, and the declaration of
- -- package Naming, if they exist.
-
- declare
- Declaration : Project_Node_Id :=
- First_Declarative_Item_Of
- (Project_Declaration_Of
- (Project_Node));
- Previous : Project_Node_Id := Empty_Node;
- Current_Node : Project_Node_Id := Empty_Node;
-
- begin
- while Declaration /= Empty_Node loop
- Current_Node := Current_Item_Node (Declaration);
-
- if (Kind_Of (Current_Node) = N_Attribute_Declaration
- and then
- (Tree.Name_Of (Current_Node) = Name_Source_Files
- or else Tree.Name_Of (Current_Node) =
- Name_Source_List_File
- or else Tree.Name_Of (Current_Node) =
- Name_Source_Dirs))
- or else
- (Kind_Of (Current_Node) = N_Package_Declaration
- and then Tree.Name_Of (Current_Node) = Name_Naming)
- then
- if Previous = Empty_Node then
- Set_First_Declarative_Item_Of
- (Project_Declaration_Of (Project_Node),
- To => Next_Declarative_Item (Declaration));
-
- else
- Set_Next_Declarative_Item
- (Previous,
- To => Next_Declarative_Item (Declaration));
- end if;
-
- else
- Previous := Declaration;
- end if;
-
- Declaration := Next_Declarative_Item (Declaration);
- end loop;
- end;
- end if;
- end if;
-
-- 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 Project_Node = Empty_Node then
- Project_Node := Default_Project_Node (Of_Kind => N_Project);
- Set_Name_Of (Project_Node, To => Output_Name_Id);
+ 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,
- To => Default_Project_Node (Of_Kind => N_Project_Declaration));
+ (Project_Node, Tree,
+ To => Default_Project_Node
+ (Of_Kind => N_Project_Declaration, In_Tree => Tree));
end if;
-- for Source_Files as an empty list, to indicate there are no
-- sources in the naming project.
- Project_Naming_Node := Default_Project_Node (Of_Kind => N_Project);
- Set_Name_Of (Project_Naming_Node, To => Project_Naming_Id);
+ 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);
- Set_Project_Declaration_Of (Project_Naming_Node, 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);
- Set_Name_Of (Naming_Package, To => Name_Naming);
+ Default_Project_Node
+ (Of_Kind => N_Package_Declaration, In_Tree => Tree);
+ Set_Name_Of (Naming_Package, Tree, To => Name_Naming);
declare
Decl_Item : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item, In_Tree => Tree);
Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- And_Expr_Kind => List);
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => List);
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- And_Expr_Kind => List);
+ Term : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Term,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
Empty_List : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String_List);
+ Default_Project_Node
+ (Of_Kind => N_Literal_String_List,
+ In_Tree => Tree);
begin
Set_First_Declarative_Item_Of
- (Project_Naming_Decl, To => Decl_Item);
- Set_Next_Declarative_Item (Decl_Item, Naming_Package);
- Set_Current_Item_Node (Decl_Item, To => Attribute);
- Set_Name_Of (Attribute, To => Name_Source_Files);
- Set_Expression_Of (Attribute, To => Expression);
- Set_First_Term (Expression, To => Term);
- Set_Current_Term (Term, To => Empty_List);
+ (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;
-- Add a with clause on the naming project in the main project
declare
With_Clause : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_With_Clause);
+ Default_Project_Node
+ (Of_Kind => N_With_Clause, In_Tree => Tree);
begin
Set_Next_With_Clause_Of
- (With_Clause, To => First_With_Clause_Of (Project_Node));
- Set_First_With_Clause_Of (Project_Node, To => With_Clause);
- Set_Name_Of (With_Clause, To => Project_Naming_Id);
+ (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);
-- We set the project node to something different than
-- Empty_Node, so that Prj.PP does not generate a limited
-- with clause.
- Set_Project_Node_Of (With_Clause, Non_Empty_Node);
+ Set_Project_Node_Of (With_Clause, Tree, Non_Empty_Node);
Name_Len := Project_Naming_Last;
Name_Buffer (1 .. Name_Len) :=
Project_Naming_File_Name (1 .. Project_Naming_Last);
- Set_String_Value_Of (With_Clause, To => Name_Find);
+ Set_String_Value_Of (With_Clause, Tree, To => Name_Find);
end;
- Project_Declaration := Project_Declaration_Of (Project_Node);
+ Project_Declaration := Project_Declaration_Of (Project_Node, Tree);
-- Add a renaming declaration for package Naming in the main project
declare
Decl_Item : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
Naming : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_Package_Declaration);
+ Default_Project_Node
+ (Of_Kind => N_Package_Declaration,
+ In_Tree => Tree);
+
begin
Set_Next_Declarative_Item
- (Decl_Item,
- To => First_Declarative_Item_Of (Project_Declaration));
+ (Decl_Item, Tree,
+ To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
- (Project_Declaration, To => Decl_Item);
- Set_Current_Item_Node (Decl_Item, To => Naming);
- Set_Name_Of (Naming, To => Name_Naming);
+ (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, To => Project_Naming_Node);
+ (Naming, Tree, To => Project_Naming_Node);
end;
-- Add an attribute declaration for Source_Dirs, initialized as an
declare
Decl_Item : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- And_Expr_Kind => List);
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => List);
+ Default_Project_Node
+ (Of_Kind => N_Expression,
+ In_Tree => Tree,
+ And_Expr_Kind => List);
Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term, And_Expr_Kind => List);
+ Default_Project_Node
+ (Of_Kind => N_Term, In_Tree => Tree,
+ And_Expr_Kind => List);
begin
Set_Next_Declarative_Item
- (Decl_Item,
- To => First_Declarative_Item_Of (Project_Declaration));
+ (Decl_Item, Tree,
+ To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
- (Project_Declaration, To => Decl_Item);
- Set_Current_Item_Node (Decl_Item, To => Attribute);
- Set_Name_Of (Attribute, To => Name_Source_Dirs);
- Set_Expression_Of (Attribute, To => Expression);
- Set_First_Term (Expression, To => Term);
+ (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,
- And_Expr_Kind => List);
- Set_Current_Term (Term, To => 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);
end;
-- Add an attribute declaration for Source_List_File with the
declare
Decl_Item : constant Project_Node_Id :=
- Default_Project_Node (Of_Kind => N_Declarative_Item);
+ Default_Project_Node
+ (Of_Kind => N_Declarative_Item,
+ In_Tree => Tree);
- Attribute : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Attribute_Declaration,
- And_Expr_Kind => Single);
+ Attribute : constant Project_Node_Id :=
+ Default_Project_Node
+ (Of_Kind => N_Attribute_Declaration,
+ In_Tree => Tree,
+ And_Expr_Kind => Single);
Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => Single);
-
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- And_Expr_Kind => Single);
-
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- And_Expr_Kind => Single);
+ 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);
begin
Set_Next_Declarative_Item
- (Decl_Item,
- To => First_Declarative_Item_Of (Project_Declaration));
+ (Decl_Item, Tree,
+ To => First_Declarative_Item_Of (Project_Declaration, Tree));
Set_First_Declarative_Item_Of
- (Project_Declaration, To => Decl_Item);
- Set_Current_Item_Node (Decl_Item, To => Attribute);
- Set_Name_Of (Attribute, To => Name_Source_List_File);
- Set_Expression_Of (Attribute, To => Expression);
- Set_First_Term (Expression, To => Term);
- Set_Current_Term (Term, To => Value);
+ (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, To => Name_Find);
+ Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end if;
Dir_Name : constant String := Directories (Index).all;
Last : Natural := Dir_Name'Last;
Recursively : Boolean := False;
+
begin
if Dir_Name'Length >= 4
and then (Dir_Name (Last - 2 .. Last) = "/**")
declare
Expression : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Expression,
- And_Expr_Kind => Single);
-
- Term : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Term,
- And_Expr_Kind => Single);
-
- Value : constant Project_Node_Id :=
- Default_Project_Node
- (Of_Kind => N_Literal_String,
- And_Expr_Kind => Single);
+ 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);
begin
if Current_Source_Dir = Empty_Node then
Set_First_Expression_In_List
- (Source_Dirs_List, To => Expression);
+ (Source_Dirs_List, Tree, To => Expression);
else
Set_Next_Expression_In_List
- (Current_Source_Dir, To => Expression);
+ (Current_Source_Dir, Tree, To => Expression);
end if;
Current_Source_Dir := Expression;
- Set_First_Term (Expression, To => Term);
- Set_Current_Term (Term, To => Value);
+ 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, To => Name_Find);
+ Set_String_Value_Of (Value, Tree, To => Name_Find);
end;
end if;
-- Output the project file
Prj.PP.Pretty_Print
- (Project_Node,
+ (Project_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
-- Output the naming project file
Prj.PP.Pretty_Print
- (Project_Naming_Node,
+ (Project_Naming_Node, Tree,
W_Char => Write_A_Char'Access,
W_Eol => Write_Eol'Access,
W_Str => Write_A_String'Access,
Write_A_String
(Get_Name_String (SFN_Pragmas.Table (Index).File));
- Write_A_String (""");");
+
+ 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;
+
+ Write_A_String (");");
Write_Eol;
end loop;
OSDN Git Service
