with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
-with Sinput; use Sinput;
with Snames;
with GNAT.Case_Util; use GNAT.Case_Util;
function Expression
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
procedure Process_Declarative_Items
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
Index : Name_Id) return Name_Id
is
Lower : Boolean;
+
begin
Get_Name_String (Index);
Lower := Case_Insensitive (Attr, Tree);
-- The index is always case insensitive if it does not include any dot.
-- ??? Why not use the properties from prj-attr, simply, maybe because
- -- we don't know whether we have a file as an index ?
+ -- we don't know whether we have a file as an index?
if not Lower then
Lower := True;
function Expression
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
Value := Expression
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg,
Expression
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg,
Def_Var := Expression
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg,
end if;
end if;
- Value := Prj.Ext.Value_Of (Name, Default);
+ Value :=
+ Prj.Ext.Value_Of (From_Project_Node_Tree, Name, Default);
if Value = No_Name then
if not Quiet_Output then
- if Report_Error = null then
- Error_Msg
- ("?undefined external reference",
- Location_Of
- (The_Current_Term, From_Project_Node_Tree));
- else
- Report_Error
- ("warning: """ & Get_Name_String (Name) &
- """ is an undefined external reference",
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags, "?undefined external reference",
+ Location_Of
+ (The_Current_Term, From_Project_Node_Tree),
+ Project);
end if;
Value := Empty_String;
procedure Process_Declarative_Items
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Report_Error : Put_Line_Access;
+ Flags : Processing_Flags;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Pkg : Package_Id;
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => New_Pkg,
end loop;
if Orig_Array = No_Array then
- if Report_Error = null then
- Error_Msg
- ("associative array value not found",
- Location_Of
- (Current_Item, From_Project_Node_Tree));
- else
- Report_Error
- ("associative array value not found",
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags,
+ "associative array value not found",
+ Location_Of (Current_Item, From_Project_Node_Tree),
+ Project);
else
Orig_Element :=
Expression
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg,
if New_Value.Value = Empty_String then
Error_Msg_Name_1 :=
Name_Of (Current_Item, From_Project_Node_Tree);
-
- if Report_Error = null then
- Error_Msg
- ("no value defined for %%",
- Location_Of
- (Current_Item, From_Project_Node_Tree));
- else
- Report_Error
- ("no value defined for " &
- Get_Name_String (Error_Msg_Name_1),
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags,
+ "no value defined for %%",
+ Location_Of
+ (Current_Item, From_Project_Node_Tree),
+ Project);
else
declare
Error_Msg_Name_2 :=
Name_Of
(Current_Item, From_Project_Node_Tree);
-
- if Report_Error = null then
- Error_Msg
- ("value %% is illegal " &
- "for typed string %%",
- Location_Of
- (Current_Item,
- From_Project_Node_Tree));
-
- else
- Report_Error
- ("value """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ is illegal for typed string """ &
- Get_Name_String (Error_Msg_Name_2) &
- """",
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags,
+ "value %% is illegal for typed string %%",
+ Location_Of
+ (Current_Item, From_Project_Node_Tree),
+ Project);
end if;
end;
end if;
else
declare
Index_Name : Name_Id :=
- Associative_Array_Index_Of
- (Current_Item, From_Project_Node_Tree);
- The_Array : Array_Id;
+ Associative_Array_Index_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+
+ Source_Index : constant Int :=
+ Source_Index_Of
+ (Current_Item,
+ From_Project_Node_Tree);
+
+ The_Array : Array_Id;
The_Array_Element : Array_Element_Id :=
No_Array_Element;
if Pkg /= No_Package then
The_Array :=
In_Tree.Packages.Table (Pkg).Decl.Arrays;
-
else
- The_Array := Project.Decl.Arrays;
+ The_Array :=
+ Project.Decl.Arrays;
end if;
while
In_Tree.Arrays.Table (The_Array).Name /=
Current_Item_Name
loop
- The_Array := In_Tree.Arrays.Table
- (The_Array).Next;
+ The_Array :=
+ In_Tree.Arrays.Table (The_Array).Next;
end loop;
-- If the array cannot be found, create a new entry
end if;
-- Look in the list, if any, to find an element
- -- with the same index.
+ -- with the same index and same source index.
while The_Array_Element /= No_Array_Element
and then
- In_Tree.Array_Elements.Table
+ (In_Tree.Array_Elements.Table
(The_Array_Element).Index /= Index_Name
+ or else
+ In_Tree.Array_Elements.Table
+ (The_Array_Element).Src_Index /= Source_Index)
loop
The_Array_Element :=
In_Tree.Array_Elements.Table
if The_Array_Element = No_Array_Element then
Array_Element_Table.Increment_Last
(In_Tree.Array_Elements);
- The_Array_Element := Array_Element_Table.Last
- (In_Tree.Array_Elements);
+ The_Array_Element :=
+ Array_Element_Table.Last
+ (In_Tree.Array_Elements);
In_Tree.Array_Elements.Table
(The_Array_Element) :=
- (Index => Index_Name,
- Src_Index =>
- Source_Index_Of
- (Current_Item, From_Project_Node_Tree),
+ (Index => Index_Name,
+ Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive
(Current_Item, From_Project_Node_Tree),
- Value => New_Value,
- Next => In_Tree.Arrays.Table
- (The_Array).Value);
- In_Tree.Arrays.Table
- (The_Array).Value := The_Array_Element;
+ Value => New_Value,
+ Next =>
+ In_Tree.Arrays.Table (The_Array).Value);
+
+ In_Tree.Arrays.Table (The_Array).Value :=
+ The_Array_Element;
-- An element with the same index already exists,
-- just replace its value with the new one.
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => Pkg,
Check (In_Tree, Project, Flags);
end if;
- -- If main project is an extending all project, set the object
- -- directory of all virtual extending projects to the object
- -- directory of the main project.
+ -- If main project is an extending all project, set object directory of
+ -- all virtual extending projects to object directory of main project.
if Project /= No_Project
and then
then
if Extending2.Virtual then
Error_Msg_Name_1 := Prj.Project.Display_Name;
-
- if Flags.Report_Error = null then
- Error_Msg
- ("project %% cannot be extended by a virtual" &
- " project with the same object directory",
- Prj.Project.Location);
- else
- Flags.Report_Error
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot be extended by a virtual " &
- "project with the same object directory",
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags,
+ "project %% cannot be extended by a virtual" &
+ " project with the same object directory",
+ Prj.Project.Location, Project);
else
Error_Msg_Name_1 := Extending2.Display_Name;
Error_Msg_Name_2 := Prj.Project.Display_Name;
-
- if Flags.Report_Error = null then
- Error_Msg
- ("project %% cannot extend project %%",
- Extending2.Location);
- Error_Msg
- ("\they share the same object directory",
- Extending2.Location);
-
- else
- Flags.Report_Error
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ cannot extend project """ &
- Get_Name_String (Error_Msg_Name_2) & """",
- Project, In_Tree);
- Flags.Report_Error
- ("they share the same object directory",
- Project, In_Tree);
- end if;
+ Error_Msg
+ (Flags,
+ "project %% cannot extend project %%",
+ Extending2.Location, Project);
+ Error_Msg
+ (Flags,
+ "\they share the same object directory",
+ Extending2.Location, Project);
end if;
end if;
(With_Clause, From_Project_Node_Tree);
New_Project := No_Project;
- if (Limited_With and No (Proj_Node))
- or (not Limited_With and Present (Proj_Node))
+ if (Limited_With and then No (Proj_Node))
+ or else (not Limited_With and then Present (Proj_Node))
then
Recursive_Process
(In_Tree => In_Tree,
declare
Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
- Tref : Source_Buffer_Ptr;
- Name : constant Name_Id :=
- Name_Of
- (From_Project_Node, From_Project_Node_Tree);
- Location : Source_Ptr :=
- Location_Of
- (From_Project_Node, From_Project_Node_Tree);
+
+ Name : constant Name_Id :=
+ Name_Of (From_Project_Node, From_Project_Node_Tree);
+
+ Name_Node : constant Tree_Private_Part.Project_Name_And_Node :=
+ Tree_Private_Part.Projects_Htable.Get
+ (From_Project_Node_Tree.Projects_HT, Name);
begin
Project := Processed_Projects.Get (Name);
Processed_Projects.Set (Name, Project);
Project.Name := Name;
+ Project.Display_Name := Name_Node.Display_Name;
Project.Qualifier :=
Project_Qualifier_Of (From_Project_Node, From_Project_Node_Tree);
Virtual_Prefix
then
Project.Virtual := True;
- Project.Display_Name := Name;
-
- -- If there is no file, for example when the project node tree is
- -- built in memory by GPS, the Display_Name cannot be found in
- -- the source, so its value is the same as Name.
-
- elsif Location = No_Location then
- Project.Display_Name := Name;
- -- Get the spelling of the project name from the project file
-
- else
- Tref := Source_Text (Get_Source_File_Index (Location));
-
- for J in 1 .. Name_Len loop
- Name_Buffer (J) := Tref (Location);
- Location := Location + 1;
- end loop;
-
- Project.Display_Name := Name_Find;
end if;
Project.Path.Display_Name :=
Process_Declarative_Items
(Project => Project,
In_Tree => In_Tree,
- Report_Error => Flags.Report_Error,
+ Flags => Flags,
From_Project_Node => From_Project_Node,
From_Project_Node_Tree => From_Project_Node_Tree,
Pkg => No_Package,
OSDN Git Service
