-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 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 Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
with Prj.Nmsc; use Prj.Nmsc;
+with Snames;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.HTable;
-- Add all attributes, starting with First, with their default
-- values to the package or project with declarations Decl.
+ procedure Check
+ (Project : in out Project_Id;
+ Process_Languages : Languages_Processed;
+ Follow_Links : Boolean);
+ -- Set all projects to not checked, then call Recursive_Check for the
+ -- main project Project. Project is set to No_Project if errors occurred.
+ -- See Prj.Nmsc.Ada_Check for information on Follow_Links.
+
function Expression
(Project : Project_Id;
From_Project_Node : Project_Node_Id;
-- recursively for all imported projects and a extended project, if any.
-- Then process the declarative items of the project.
- procedure Check (Project : in out Project_Id);
- -- Set all projects to not checked, then call Recursive_Check for the
- -- main project Project. Project is set to No_Project if errors occurred.
-
- procedure Recursive_Check (Project : Project_Id);
+ procedure Recursive_Check
+ (Project : Project_Id;
+ Process_Languages : Languages_Processed;
+ Follow_Links : Boolean);
-- If Project is not marked as checked, mark it as checked, call
-- Check_Naming_Scheme for the project, then call itself for a
-- possible extended project and all the imported projects of Project.
+ -- See Prj.Nmsc.Ada_Check for information on Follow_Links
---------
-- Add --
First : Attribute_Node_Id)
is
The_Attribute : Attribute_Node_Id := First;
- Attribute_Data : Attribute_Record;
begin
while The_Attribute /= Empty_Attribute loop
- Attribute_Data := Attributes.Table (The_Attribute);
-
- if Attribute_Data.Kind_2 = Single then
+ if Attribute_Kind_Of (The_Attribute) = Single then
declare
New_Attribute : Variable_Value;
begin
- case Attribute_Data.Kind_1 is
+ case Variable_Kind_Of (The_Attribute) is
-- Undefined should not happen
Kind => Single,
Location => No_Location,
Default => True,
- Value => Empty_String);
+ Value => Empty_String,
+ Index => 0);
-- List attributes have a default value of nil list
Variable_Elements.Increment_Last;
Variable_Elements.Table (Variable_Elements.Last) :=
(Next => Decl.Attributes,
- Name => Attribute_Data.Name,
+ Name => Attribute_Name_Of (The_Attribute),
Value => New_Attribute);
Decl.Attributes := Variable_Elements.Last;
end;
end if;
- The_Attribute := Attributes.Table (The_Attribute).Next;
+ The_Attribute := Next_Attribute (After => The_Attribute);
end loop;
end Add_Attributes;
-- Check --
-----------
- procedure Check (Project : in out Project_Id) is
+ procedure Check
+ (Project : in out Project_Id;
+ Process_Languages : Languages_Processed;
+ Follow_Links : Boolean) is
begin
-- Make sure that all projects are marked as not checked
Projects.Table (Index).Checked := False;
end loop;
- Recursive_Check (Project);
+ Recursive_Check (Project, Process_Languages, Follow_Links);
end Check;
when Single =>
Add (Result.Value, String_Value_Of (The_Current_Term));
+ Result.Index := Source_Index_Of (The_Current_Term);
when List =>
Last := String_Elements.Last;
String_Elements.Table (Last) :=
(Value => String_Value_Of (The_Current_Term),
+ Index => Source_Index_Of (The_Current_Term),
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
Display_Value => No_Name,
Location => Value.Location,
Flag => False,
- Next => Nil_String);
+ Next => Nil_String,
+ Index => Value.Index);
loop
-- Add the other element of the literal string list
Display_Value => No_Name,
Location => Value.Location,
Flag => False,
- Next => Nil_String);
+ Next => Nil_String,
+ Index => Value.Index);
end loop;
end if;
Kind => Single,
Location => No_Location,
Default => True,
- Value => Empty_String);
+ Value => Empty_String,
+ Index => 0);
end if;
end if;
end;
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
- Next => Nil_String);
+ Next => Nil_String,
+ Index => 0);
when List =>
Location => Location_Of
(The_Current_Term),
Flag => False,
- Next => Nil_String);
+ Next => Nil_String,
+ Index => 0);
The_List :=
String_Elements.Table (The_List).Next;
end loop;
Display_Value => No_Name,
Location => Location_Of (The_Current_Term),
Flag => False,
- Next => Nil_String);
+ Next => Nil_String,
+ Index => 0);
end case;
end;
(Project : out Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
- Report_Error : Put_Line_Access)
+ Report_Error : Put_Line_Access;
+ Process_Languages : Languages_Processed := Ada_Language;
+ Follow_Links : Boolean := True)
is
- Obj_Dir : Name_Id;
- Extending : Project_Id;
+ Obj_Dir : Name_Id;
+ Extending : Project_Id;
+ Extending2 : Project_Id;
begin
Error_Report := Report_Error;
Extended_By => No_Project);
if Project /= No_Project then
- Check (Project);
+ Check (Project, Process_Languages, Follow_Links);
end if;
-- If main project is an extending all project, set the object
end;
end if;
- -- Check that no extended project shares its object directory with
- -- another project.
+ -- Check that no extending project shares its object directory with
+ -- the project(s) it extends.
if Project /= No_Project then
- for Extended in 1 .. Projects.Last loop
- Extending := Projects.Table (Extended).Extended_By;
+ for Proj in 1 .. Projects.Last loop
+ Extending := Projects.Table (Proj).Extended_By;
if Extending /= No_Project then
- Obj_Dir := Projects.Table (Extended).Object_Directory;
-
- for Prj in 1 .. Projects.Last loop
- if Prj /= Extended
- and then Projects.Table (Prj).Sources_Present
- and then Projects.Table (Prj).Object_Directory = Obj_Dir
+ Obj_Dir := Projects.Table (Proj).Object_Directory;
+
+ -- Check that a project being extended does not share its
+ -- object directory with any project that extends it, directly
+ -- or indirectly, including a virtual extending project.
+
+ -- Start with the project directly extending it
+
+ Extending2 := Extending;
+
+ while Extending2 /= No_Project loop
+ if ((Process_Languages = Ada_Language
+ and then
+ Projects.Table (Extending2).Ada_Sources_Present)
+ or else
+ (Process_Languages = Other_Languages
+ and then
+ Projects.Table (Extending2).Other_Sources_Present))
+ and then
+ Projects.Table (Extending2).Object_Directory = Obj_Dir
then
- if Projects.Table (Extending).Virtual then
- Error_Msg_Name_1 := Projects.Table (Extended).Name;
+ if Projects.Table (Extending2).Virtual then
+ Error_Msg_Name_1 := Projects.Table (Proj).Name;
if Error_Report = null then
Error_Msg
- ("project % cannot be extended by " &
- "a virtual project",
- Projects.Table (Extending).Location);
+ ("project % cannot be extended by a virtual " &
+ "project with the same object directory",
+ Projects.Table (Proj).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
- """ cannot be extended by a virtual project",
+ """ cannot be extended by a virtual " &
+ "project with the same object directory",
Project);
end if;
else
- Error_Msg_Name_1 := Projects.Table (Extending).Name;
- Error_Msg_Name_2 := Projects.Table (Extended).Name;
+ Error_Msg_Name_1 :=
+ Projects.Table (Extending2).Name;
+ Error_Msg_Name_2 := Projects.Table (Proj).Name;
if Error_Report = null then
- Error_Msg ("project % cannot extend project %",
- Projects.Table (Extending).Location);
+ Error_Msg
+ ("project % cannot extend project %",
+ Projects.Table (Extending2).Location);
+ Error_Msg
+ ("\they share the same object directory",
+ Projects.Table (Extending2).Location);
else
Error_Report
("project """ &
Get_Name_String (Error_Msg_Name_1) &
""" cannot extend project """ &
- Get_Name_String (Error_Msg_Name_2) & '"',
+ Get_Name_String (Error_Msg_Name_2) & """",
+ Project);
+ Error_Report
+ ("they share the same object directory",
Project);
end if;
end if;
+ end if;
- Error_Msg_Name_1 := Projects.Table (Extended).Name;
- Error_Msg_Name_2 := Projects.Table (Prj).Name;
-
- if Error_Report = null then
- Error_Msg
- ("\project % has the same object directory " &
- "as project %",
- Projects.Table (Extending).Location);
-
- else
- Error_Report
- ("project """ &
- Get_Name_String (Error_Msg_Name_1) &
- """ has the same object directory as project """ &
- Get_Name_String (Error_Msg_Name_2) & '"',
- Project);
- end if;
+ -- Continue with the next extending project, if any
- Project := No_Project;
- exit;
- end if;
+ Extending2 := Projects.Table (Extending2).Extended_By;
end loop;
end if;
end loop;
Add_Attributes
(Project,
Packages.Table (New_Pkg).Decl,
- Package_Attributes.Table
- (Package_Id_Of (Current_Item)).First_Attribute);
+ First_Attribute_Of
+ (Package_Id_Of (Current_Item)));
-- And process declarative items of the new package
Array_Elements.Table (The_Array_Element) :=
(Index => Index_Name,
+ Src_Index => Source_Index_Of (Current_Item),
Index_Case_Sensitive =>
not Case_Insensitive (Current_Item),
Value => New_Value,
-- Recursive_Check --
---------------------
- procedure Recursive_Check (Project : Project_Id) is
+ procedure Recursive_Check
+ (Project : Project_Id;
+ Process_Languages : Languages_Processed;
+ Follow_Links : Boolean)
+ is
Data : Project_Data;
Imported_Project_List : Project_List := Empty_Project_List;
-- Call itself for a possible extended project.
-- (if there is no extended project, then nothing happens).
- Recursive_Check (Data.Extends);
+ Recursive_Check (Data.Extends, Process_Languages, Follow_Links);
-- Call itself for all imported projects
Imported_Project_List := Data.Imported_Projects;
while Imported_Project_List /= Empty_Project_List loop
Recursive_Check
- (Project_Lists.Table (Imported_Project_List).Project);
+ (Project_Lists.Table (Imported_Project_List).Project,
+ Process_Languages, Follow_Links);
Imported_Project_List :=
Project_Lists.Table (Imported_Project_List).Next;
end loop;
Write_Line ("""");
end if;
- Prj.Nmsc.Ada_Check (Project, Error_Report);
+ case Process_Languages is
+ when Ada_Language =>
+ Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
+
+ when Other_Languages =>
+ Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
+
+ when All_Languages =>
+ Prj.Nmsc.Ada_Check (Project, Error_Report, Follow_Links);
+ Prj.Nmsc.Other_Languages_Check (Project, Error_Report);
+
+ end case;
end if;
end Recursive_Check;
else
declare
- Processed_Data : Project_Data := Empty_Project;
- Imported : Project_List := Empty_Project_List;
- Declaration_Node : Project_Node_Id := Empty_Node;
- Name : constant Name_Id :=
- Name_Of (From_Project_Node);
+ Processed_Data : Project_Data := Empty_Project;
+ Imported : Project_List := Empty_Project_List;
+ Declaration_Node : Project_Node_Id := Empty_Node;
+ Name : constant Name_Id := Name_Of (From_Project_Node);
begin
Project := Processed_Projects.Get (Name);
-- If it is an extending project, inherit all packages
-- from the extended project that are not explicitely defined
- -- or renamed.
+ -- or renamed. Also inherit the languages, if attribute Languages
+ -- is not explicitely defined.
if Processed_Data.Extends /= No_Project then
Processed_Data := Projects.Table (Project);
Element : Package_Element;
First : constant Package_Id :=
Processed_Data.Decl.Packages;
+ Attribute1 : Variable_Id;
+ Attribute2 : Variable_Id;
+ Attr_Value1 : Variable;
+ Attr_Value2 : Variable;
begin
while Extended_Pkg /= No_Package loop
Extended_Pkg := Element.Next;
end loop;
+
+ -- Check if attribute Languages is declared in the
+ -- extending project.
+
+ Attribute1 := Processed_Data.Decl.Attributes;
+ while Attribute1 /= No_Variable loop
+ Attr_Value1 := Variable_Elements.Table (Attribute1);
+ exit when Attr_Value1.Name = Snames.Name_Languages;
+ Attribute1 := Attr_Value1.Next;
+ end loop;
+
+ if Attribute1 = No_Variable or else
+ Attr_Value1.Value.Default
+ then
+ -- Attribute Languages is not declared in the extending
+ -- project. Check if it is declared in the project being
+ -- extended.
+
+ Attribute2 :=
+ Projects.Table (Processed_Data.Extends).Decl.Attributes;
+
+ while Attribute2 /= No_Variable loop
+ Attr_Value2 := Variable_Elements.Table (Attribute2);
+ exit when Attr_Value2.Name = Snames.Name_Languages;
+ Attribute2 := Attr_Value2.Next;
+ end loop;
+
+ if Attribute2 /= No_Variable and then
+ not Attr_Value2.Value.Default
+ then
+ -- As attribute Languages is declared in the project
+ -- being extended, copy its value for the extending
+ -- project.
+
+ if Attribute1 = No_Variable then
+ Variable_Elements.Increment_Last;
+ Attribute1 := Variable_Elements.Last;
+ Attr_Value1.Next := Processed_Data.Decl.Attributes;
+ Processed_Data.Decl.Attributes := Attribute1;
+ end if;
+
+ Attr_Value1.Name := Snames.Name_Languages;
+ Attr_Value1.Value := Attr_Value2.Value;
+ Variable_Elements.Table (Attribute1) := Attr_Value1;
+ end if;
+ end if;
end;
Projects.Table (Project) := Processed_Data;
OSDN Git Service
