Skip to content

R
riscv-gcc-1
Commit 347ab254 by Emmanuel Briot Committed by Arnaud Charlet
Options

prj.ads, [...] (Recursive_Process): Remove duplicated code. 

2009-04-22  Emmanuel Briot  <briot@adacore.com>

	* prj.ads, prj.adb, prj-nmsc.adb, prj-proc.adb (Recursive_Process):
	Remove duplicated code.
	(Canonical_Case_File_Name): new subprogram
	(Check_And_Normalize_Unit_Names): new subprogram
	(Write_Attr): new subprogram
	Better sharing of code
	(Check_Naming_Ada_Only, Check_Naming_Multi_Lang): new subprogram, to
	split Check_Naming and help find duplicated code
	(Check_Common): new subprogram, sharing code between ada_only and
	multi_language mode.
	(Naming_Data.Dot_Repl_Loc): field removed

From-SVN: r146567
parent 24a40b35
Showing with 416 additions and 657 deletions
gcc/ada/ChangeLog
2009-04-22 Emmanuel Briot <briot@adacore.com> 2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj.ads, prj.adb, prj-nmsc.adb, prj-proc.adb (Recursive_Process):
Remove duplicated code.
(Canonical_Case_File_Name): new subprogram
(Check_And_Normalize_Unit_Names): new subprogram
(Write_Attr): new subprogram
Better sharing of code
(Check_Naming_Ada_Only, Check_Naming_Multi_Lang): new subprogram, to
split Check_Naming and help find duplicated code
(Check_Common): new subprogram, sharing code between ada_only and
multi_language mode.
(Naming_Data.Dot_Repl_Loc): field removed
2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram. * prj-proc.adb, prj-nmsc.adb (Load_Naming_Exceptions): New subprogram.
Minor refactoring to reduce the size of Minor refactoring to reduce the size of
Process_Sources_In_Multi_Language_Mode. Process_Sources_In_Multi_Language_Mode.
......
gcc/ada/prj-nmsc.adb
...@@ -250,6 +250,10 @@ package body Prj.Nmsc is ...@@ -250,6 +250,10 @@ package body Prj.Nmsc is
-- If Source_To_Replace is specified, it points to the source in the -- If Source_To_Replace is specified, it points to the source in the
-- extended project that the new file is overriding. -- extended project that the new file is overriding.
function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
-- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
-- This alters Name_Buffer
function ALI_File_Name (Source : String) return String; function ALI_File_Name (Source : String) return String;
-- Return the ALI file name corresponding to a source -- Return the ALI file name corresponding to a source
...@@ -332,6 +336,16 @@ package body Prj.Nmsc is ...@@ -332,6 +336,16 @@ package body Prj.Nmsc is
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
procedure Check_And_Normalize_Unit_Names
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
List : Array_Element_Id;
Debug_Name : String);
-- Check that a list of unit names contains only valid names. Casing
-- is normalized where appropriate.
-- Debug_Name is the name representing the list, and is used for debug
-- output only.
procedure Get_Path_Names_And_Record_Ada_Sources procedure Get_Path_Names_And_Record_Ada_Sources
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
...@@ -510,7 +524,8 @@ package body Prj.Nmsc is ...@@ -510,7 +524,8 @@ package body Prj.Nmsc is
Current_Dir : String); Current_Dir : String);
-- Find all the sources of project Project in project tree In_Tree and -- Find all the sources of project Project in project tree In_Tree and
-- update its Data accordingly. This assumes that Data.First_Source has -- update its Data accordingly. This assumes that Data.First_Source has
-- been initialized with the list of excluded sources. -- been initialized with the list of excluded sources and special naming
-- exceptions.
-- --
-- Current_Dir should represent the current directory, and is passed for -- Current_Dir should represent the current directory, and is passed for
-- efficiency to avoid system calls to recompute it. -- efficiency to avoid system calls to recompute it.
...@@ -574,6 +589,24 @@ package body Prj.Nmsc is ...@@ -574,6 +589,24 @@ package body Prj.Nmsc is
-- Check that individual naming conventions apply to immediate sources of -- Check that individual naming conventions apply to immediate sources of
-- the project. If not, issue a warning. -- the project. If not, issue a warning.
procedure Write_Attr (Name, Value : String);
-- Debug print a value for a specific property. Does nothing when not in
-- debug mode
----------------
-- Write_Attr --
----------------
procedure Write_Attr (Name, Value : String) is
begin
if Current_Verbosity = High then
Write_Str (" " & Name & " = """);
Write_Str (Value);
Write_Char ('"');
Write_Eol;
end if;
end Write_Attr;
---------------- ----------------
-- Add_Source -- -- Add_Source --
---------------- ----------------
...@@ -718,6 +751,21 @@ package body Prj.Nmsc is ...@@ -718,6 +751,21 @@ package body Prj.Nmsc is
return Source & ALI_Suffix; return Source & ALI_Suffix;
end ALI_File_Name; end ALI_File_Name;
------------------------------
-- Canonical_Case_File_Name --
------------------------------
function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
begin
if Osint.File_Names_Case_Sensitive then
return File_Name_Type (Name);
else
Get_Name_String (Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
return Name_Find;
end if;
end Canonical_Case_File_Name;
----------- -----------
-- Check -- -- Check --
----------- -----------
...@@ -1097,37 +1145,6 @@ package body Prj.Nmsc is ...@@ -1097,37 +1145,6 @@ package body Prj.Nmsc is
(Naming.Separate_Suffix); (Naming.Separate_Suffix);
begin begin
-- Dot_Replacement cannot
-- - be empty
-- - start or end with an alphanumeric
-- - be a single '_'
-- - start with an '_' followed by an alphanumeric
-- - contain a '.' except if it is "."
if Dot_Replacement'Length = 0
or else Is_Alphanumeric
(Dot_Replacement (Dot_Replacement'First))
or else Is_Alphanumeric
(Dot_Replacement (Dot_Replacement'Last))
or else (Dot_Replacement (Dot_Replacement'First) = '_'
and then
(Dot_Replacement'Length = 1
or else
Is_Alphanumeric
(Dot_Replacement (Dot_Replacement'First + 1))))
or else (Dot_Replacement'Length > 1
and then
Index (Source => Dot_Replacement,
Pattern => ".") /= 0)
then
Error_Msg
(Project, In_Tree,
'"' & Dot_Replacement &
""" is illegal for Dot_Replacement.",
Naming.Dot_Repl_Loc);
end if;
-- Suffixes cannot -- Suffixes cannot
-- - be empty -- - be empty
...@@ -2655,9 +2672,7 @@ package body Prj.Nmsc is ...@@ -2655,9 +2672,7 @@ package body Prj.Nmsc is
List := Interfaces.Values; List := Interfaces.Values;
while List /= Nil_String loop while List /= Nil_String loop
Element := In_Tree.String_Elements.Table (List); Element := In_Tree.String_Elements.Table (List);
Get_Name_String (Element.Value); Name := Canonical_Case_File_Name (Element.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
Project_2 := Project; Project_2 := Project;
Data_2 := Data; Data_2 := Data;
...@@ -2744,6 +2759,55 @@ package body Prj.Nmsc is ...@@ -2744,6 +2759,55 @@ package body Prj.Nmsc is
end if; end if;
end Check_Interfaces; end Check_Interfaces;
------------------------------------
-- Check_And_Normalize_Unit_Names --
------------------------------------
procedure Check_And_Normalize_Unit_Names
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
List : Array_Element_Id;
Debug_Name : String)
is
Current : Array_Element_Id := List;
Element : Array_Element;
Unit_Name : Name_Id;
begin
if Current_Verbosity = High then
Write_Line (" Checking unit names in " & Debug_Name);
end if;
while Current /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Current);
Element.Value.Value :=
Name_Id (Canonical_Case_File_Name (Element.Value.Value));
-- Check that it contains a valid unit name
Get_Name_String (Element.Index);
Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
if Unit_Name = No_Name then
Err_Vars.Error_Msg_Name_1 := Element.Index;
Error_Msg
(Project, In_Tree,
"%% is not a valid unit name.",
Element.Value.Location);
else
if Current_Verbosity = High then
Write_Str (" for unit: ");
Write_Line (Get_Name_String (Unit_Name));
end if;
Element.Index := Unit_Name;
In_Tree.Array_Elements.Table (Current) := Element;
end if;
Current := Element.Next;
end loop;
end Check_And_Normalize_Unit_Names;
-------------------------- --------------------------
-- Check_Naming_Schemes -- -- Check_Naming_Schemes --
-------------------------- --------------------------
...@@ -2757,65 +2821,148 @@ package body Prj.Nmsc is ...@@ -2757,65 +2821,148 @@ package body Prj.Nmsc is
Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree); Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
Naming : Package_Element; Naming : Package_Element;
procedure Check_Unit_Names (List : Array_Element_Id);
-- Check that a list of unit names contains only valid names
procedure Get_Exceptions (Kind : Source_Kind); procedure Get_Exceptions (Kind : Source_Kind);
-- Comment required ??? -- Comment required ???
procedure Get_Unit_Exceptions (Kind : Source_Kind); procedure Get_Unit_Exceptions (Kind : Source_Kind);
-- Comment required ??? -- Comment required ???
---------------------- procedure Check_Naming_Ada_Only;
-- Check_Unit_Names -- -- Does Check_Naming_Schemes processing in Ada_Only mode.
---------------------- -- If there is a package Naming, puts in Data.Naming the contents of
-- this package.
procedure Check_Unit_Names (List : Array_Element_Id) is procedure Check_Naming_Multi_Lang;
Current : Array_Element_Id; -- Does Check_Naming_Schemes processing for Multi_Language mode.
Element : Array_Element;
Unit_Name : Name_Id; procedure Check_Common
(Dot_Replacement : in out File_Name_Type;
Casing : in out Casing_Type;
Casing_Defined : out Boolean;
Separate_Suffix : in out File_Name_Type;
Sep_Suffix_Loc : in out Source_Ptr);
-- Check attributes common to Ada_Only and Multi_Lang modes
------------------
-- Check_Common --
------------------
procedure Check_Common
(Dot_Replacement : in out File_Name_Type;
Casing : in out Casing_Type;
Casing_Defined : out Boolean;
Separate_Suffix : in out File_Name_Type;
Sep_Suffix_Loc : in out Source_Ptr)
is
Dot_Repl : constant Variable_Value :=
Util.Value_Of
(Name_Dot_Replacement, Naming.Decl.Attributes, In_Tree);
Casing_String : constant Variable_Value :=
Util.Value_Of (Name_Casing, Naming.Decl.Attributes, In_Tree);
Sep_Suffix : constant Variable_Value :=
Util.Value_Of
(Name_Separate_Suffix, Naming.Decl.Attributes, In_Tree);
Dot_Repl_Loc : Source_Ptr;
begin begin
-- Loop through elements of the string list if not Dot_Repl.Default then
pragma Assert
(Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
if Length_Of_Name (Dot_Repl.Value) = 0 then
Error_Msg
(Project, In_Tree,
"Dot_Replacement cannot be empty",
Dot_Repl.Location);
end if;
Current := List; Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
while Current /= No_Array_Element loop Dot_Repl_Loc := Dot_Repl.Location;
Element := In_Tree.Array_Elements.Table (Current);
-- Put file name in canonical case declare
Repl : constant String := Get_Name_String (Dot_Replacement);
begin
-- Dot_Replacement cannot
-- - be empty
-- - start or end with an alphanumeric
-- - be a single '_'
-- - start with an '_' followed by an alphanumeric
-- - contain a '.' except if it is "."
if not Osint.File_Names_Case_Sensitive then if Repl'Length = 0
Get_Name_String (Element.Value.Value); or else Is_Alphanumeric (Repl (Repl'First))
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); or else Is_Alphanumeric (Repl (Repl'Last))
Element.Value.Value := Name_Find; or else (Repl (Repl'First) = '_'
and then
(Repl'Length = 1
or else Is_Alphanumeric (Repl (Repl'First + 1))))
or else (Repl'Length > 1
and then Index (Source => Repl, Pattern => ".") /= 0)
then
Error_Msg
(Project, In_Tree,
'"' & Repl &
""" is illegal for Dot_Replacement.",
Dot_Repl_Loc);
end if;
end;
end if; end if;
-- Check that it contains a valid unit name Write_Attr
("Dot_Replacement", Get_Name_String (Dot_Replacement));
Get_Name_String (Element.Index); Casing_Defined := False;
Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
if Unit_Name = No_Name then if not Casing_String.Default then
Err_Vars.Error_Msg_Name_1 := Element.Index; pragma Assert
(Casing_String.Kind = Single, "Casing is not a string");
declare
Casing_Image : constant String :=
Get_Name_String (Casing_String.Value);
begin
if Casing_Image'Length = 0 then
Error_Msg Error_Msg
(Project, In_Tree, (Project, In_Tree,
"%% is not a valid unit name.", "Casing cannot be an empty string",
Element.Value.Location); Casing_String.Location);
end if;
else Casing := Value (Casing_Image);
if Current_Verbosity = High then Casing_Defined := True;
Write_Str (" Unit (""");
Write_Str (Get_Name_String (Unit_Name)); exception
Write_Line (""")"); when Constraint_Error =>
Name_Len := Casing_Image'Length;
Name_Buffer (1 .. Name_Len) := Casing_Image;
Err_Vars.Error_Msg_Name_1 := Name_Find;
Error_Msg
(Project, In_Tree,
"%% is not a correct Casing",
Casing_String.Location);
end;
end if; end if;
Element.Index := Unit_Name; Write_Attr ("Casing", Image (Casing));
In_Tree.Array_Elements.Table (Current) := Element;
if not Sep_Suffix.Default then
if Length_Of_Name (Sep_Suffix.Value) = 0 then
Error_Msg
(Project, In_Tree,
"Separate_Suffix cannot be empty",
Sep_Suffix.Location);
else
Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
Sep_Suffix_Loc := Sep_Suffix.Location;
end if;
end if; end if;
Current := Element.Next; if Separate_Suffix /= No_File then
end loop; Write_Attr
end Check_Unit_Names; ("Separate_Suffix", Get_Name_String (Separate_Suffix));
end if;
end Check_Common;
-------------------- --------------------
-- Get_Exceptions -- -- Get_Exceptions --
...@@ -2866,14 +3013,7 @@ package body Prj.Nmsc is ...@@ -2866,14 +3013,7 @@ package body Prj.Nmsc is
Element_Id := Exception_List.Values; Element_Id := Exception_List.Values;
while Element_Id /= Nil_String loop while Element_Id /= Nil_String loop
Element := In_Tree.String_Elements.Table (Element_Id); Element := In_Tree.String_Elements.Table (Element_Id);
File_Name := Canonical_Case_File_Name (Element.Value);
if Osint.File_Names_Case_Sensitive then
File_Name := File_Name_Type (Element.Value);
else
Get_Name_String (Element.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
File_Name := Name_Find;
end if;
Source := Data.First_Source; Source := Data.First_Source;
while Source /= No_Source while Source /= No_Source
...@@ -2995,14 +3135,7 @@ package body Prj.Nmsc is ...@@ -2995,14 +3135,7 @@ package body Prj.Nmsc is
while Exceptions /= No_Array_Element loop while Exceptions /= No_Array_Element loop
Element := In_Tree.Array_Elements.Table (Exceptions); Element := In_Tree.Array_Elements.Table (Exceptions);
File_Name := Canonical_Case_File_Name (Element.Value.Value);
if Osint.File_Names_Case_Sensitive then
File_Name := File_Name_Type (Element.Value.Value);
else
Get_Name_String (Element.Value.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
File_Name := Name_Find;
end if;
Get_Name_String (Element.Index); Get_Name_String (Element.Index);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
...@@ -3099,169 +3232,31 @@ package body Prj.Nmsc is ...@@ -3099,169 +3232,31 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
Exceptions := Element.Next; Exceptions := Element.Next;
end loop; end loop;
end Get_Unit_Exceptions;
end Get_Unit_Exceptions;
-- Start of processing for Check_Naming_Schemes
begin
if Get_Mode = Ada_Only then
-- If there is a package Naming, we will put in Data.Naming what is
-- in this package Naming.
if Naming_Id /= No_Package then
Naming := In_Tree.Packages.Table (Naming_Id);
if Current_Verbosity = High then
Write_Line ("Checking ""Naming"" for Ada.");
end if;
declare
Bodies : constant Array_Element_Id :=
Util.Value_Of
(Name_Body, Naming.Decl.Arrays, In_Tree);
Specs : constant Array_Element_Id :=
Util.Value_Of
(Name_Spec, Naming.Decl.Arrays, In_Tree);
begin
if Bodies /= No_Array_Element then
-- We have elements in the array Body_Part
if Current_Verbosity = High then
Write_Line ("Found Bodies.");
end if;
Data.Naming.Bodies := Bodies;
Check_Unit_Names (Bodies);
else
if Current_Verbosity = High then
Write_Line ("No Bodies.");
end if;
end if;
if Specs /= No_Array_Element then
-- We have elements in the array Specs
if Current_Verbosity = High then
Write_Line ("Found Specs.");
end if;
Data.Naming.Specs := Specs;
Check_Unit_Names (Specs);
else
if Current_Verbosity = High then
Write_Line ("No Specs.");
end if;
end if;
end;
-- We are now checking if variables Dot_Replacement, Casing,
-- Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
-- For each variable, if it does not exist, we do nothing,
-- because we already have the default.
-- Check Dot_Replacement
declare
Dot_Replacement : constant Variable_Value :=
Util.Value_Of
(Name_Dot_Replacement,
Naming.Decl.Attributes, In_Tree);
begin
pragma Assert (Dot_Replacement.Kind = Single,
"Dot_Replacement is not a single string");
if not Dot_Replacement.Default then
Get_Name_String (Dot_Replacement.Value);
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"Dot_Replacement cannot be empty",
Dot_Replacement.Location);
else
if Osint.File_Names_Case_Sensitive then
Data.Naming.Dot_Replacement :=
File_Name_Type (Dot_Replacement.Value);
else
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Data.Naming.Dot_Replacement := Name_Find;
end if;
Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
end if;
end if;
end;
if Current_Verbosity = High then
Write_Str (" Dot_Replacement = """);
Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
Write_Char ('"');
Write_Eol;
end if;
-- Check Casing
declare
Casing_String : constant Variable_Value :=
Util.Value_Of
(Name_Casing,
Naming.Decl.Attributes,
In_Tree);
begin ---------------------------
pragma Assert (Casing_String.Kind = Single, -- Check_Naming_Ada_Only --
"Casing is not a single string"); ---------------------------
if not Casing_String.Default then procedure Check_Naming_Ada_Only is
declare Casing_Defined : Boolean;
Casing_Image : constant String :=
Get_Name_String (Casing_String.Value);
begin
declare
Casing_Value : constant Casing_Type :=
Value (Casing_Image);
begin begin
Data.Naming.Casing := Casing_Value; Data.Naming.Bodies :=
end; Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
exception
when Constraint_Error =>
if Casing_Image'Length = 0 then
Error_Msg
(Project, In_Tree,
"Casing cannot be an empty string",
Casing_String.Location);
else if Data.Naming.Bodies /= No_Array_Element then
Name_Len := Casing_Image'Length; Check_And_Normalize_Unit_Names
Name_Buffer (1 .. Name_Len) := Casing_Image; (Project, In_Tree, Data.Naming.Bodies, "Naming.Bodies");
Err_Vars.Error_Msg_Name_1 := Name_Find;
Error_Msg
(Project, In_Tree,
"%% is not a correct Casing",
Casing_String.Location);
end if;
end;
end if; end if;
end;
if Current_Verbosity = High then Data.Naming.Specs :=
Write_Str (" Casing = "); Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
Write_Str (Image (Data.Naming.Casing));
Write_Char ('.'); if Data.Naming.Specs /= No_Array_Element then
Write_Eol; Check_And_Normalize_Unit_Names
(Project, In_Tree, Data.Naming.Specs, "Naming.Specs");
end if; end if;
-- Check Spec_Suffix -- Check Spec_Suffix
...@@ -3278,26 +3273,19 @@ package body Prj.Nmsc is ...@@ -3278,26 +3273,19 @@ package body Prj.Nmsc is
if Ada_Spec_Suffix.Kind = Single if Ada_Spec_Suffix.Kind = Single
and then Get_Name_String (Ada_Spec_Suffix.Value) /= "" and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
then then
Get_Name_String (Ada_Spec_Suffix.Value); Set_Spec_Suffix
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); (In_Tree, "ada", Data.Naming,
Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Name_Find); Canonical_Case_File_Name (Ada_Spec_Suffix.Value));
Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location; Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
else else
Set_Spec_Suffix Set_Spec_Suffix
(In_Tree, (In_Tree, "ada", Data.Naming, Default_Ada_Spec_Suffix);
"ada",
Data.Naming,
Default_Ada_Spec_Suffix);
end if; end if;
end;
if Current_Verbosity = High then Write_Attr
Write_Str (" Spec_Suffix = """); ("Spec_Suffix", Spec_Suffix_Of (In_Tree, "ada", Data.Naming));
Write_Str (Spec_Suffix_Of (In_Tree, "ada", Data.Naming)); end;
Write_Char ('"');
Write_Eol;
end if;
-- Check Body_Suffix -- Check Body_Suffix
...@@ -3313,81 +3301,38 @@ package body Prj.Nmsc is ...@@ -3313,81 +3301,38 @@ package body Prj.Nmsc is
if Ada_Body_Suffix.Kind = Single if Ada_Body_Suffix.Kind = Single
and then Get_Name_String (Ada_Body_Suffix.Value) /= "" and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
then then
Get_Name_String (Ada_Body_Suffix.Value); Data.Naming.Separate_Suffix :=
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Canonical_Case_File_Name (Ada_Body_Suffix.Value);
Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find); Set_Body_Suffix
(In_Tree, "ada", Data.Naming, Data.Naming.Separate_Suffix);
Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location; Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
else else
Data.Naming.Separate_Suffix := Default_Ada_Body_Suffix;
Set_Body_Suffix Set_Body_Suffix
(In_Tree, (In_Tree, "ada", Data.Naming, Default_Ada_Body_Suffix);
"ada",
Data.Naming,
Default_Ada_Body_Suffix);
end if;
end;
if Current_Verbosity = High then
Write_Str (" Body_Suffix = """);
Write_Str (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
Write_Char ('"');
Write_Eol;
end if; end if;
-- Check Separate_Suffix Write_Attr
("Body_Suffix", Body_Suffix_Of (In_Tree, "ada", Data.Naming));
declare
Ada_Sep_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
(Variable_Name => Name_Separate_Suffix,
In_Variables => Naming.Decl.Attributes,
In_Tree => In_Tree);
begin
if Ada_Sep_Suffix.Default then
Data.Naming.Separate_Suffix :=
Body_Suffix_Id_Of (In_Tree, Name_Ada, Data.Naming);
else
Get_Name_String (Ada_Sep_Suffix.Value);
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"Separate_Suffix cannot be empty",
Ada_Sep_Suffix.Location);
else
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Data.Naming.Separate_Suffix := Name_Find;
Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
end if;
end if;
end; end;
if Current_Verbosity = High then Check_Common
Write_Str (" Separate_Suffix = """); (Dot_Replacement => Data.Naming.Dot_Replacement,
Write_Str (Get_Name_String (Data.Naming.Separate_Suffix)); Casing => Data.Naming.Casing,
Write_Char ('"'); Casing_Defined => Casing_Defined,
Write_Eol; Separate_Suffix => Data.Naming.Separate_Suffix,
end if; Sep_Suffix_Loc => Data.Naming.Sep_Suffix_Loc);
-- Check if Data.Naming is valid
Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming); Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
end if; end Check_Naming_Ada_Only;
elsif not In_Configuration then
-- Look into package Naming, if there is one
if Naming_Id /= No_Package then
Naming := In_Tree.Packages.Table (Naming_Id);
if Current_Verbosity = High then -----------------------------
Write_Line ("Checking package Naming."); -- Check_Naming_Multi_Lang --
end if; -----------------------------
procedure Check_Naming_Multi_Lang is
begin
-- We are now checking if attribute Dot_Replacement, Casing, -- We are now checking if attribute Dot_Replacement, Casing,
-- and/or Separate_Suffix exist. -- and/or Separate_Suffix exist.
...@@ -3397,123 +3342,25 @@ package body Prj.Nmsc is ...@@ -3397,123 +3342,25 @@ package body Prj.Nmsc is
-- value in the language config. -- value in the language config.
declare declare
Dot_Repl : constant Variable_Value :=
Util.Value_Of
(Name_Dot_Replacement,
Naming.Decl.Attributes, In_Tree);
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
Casing_String : constant Variable_Value :=
Util.Value_Of
(Name_Casing,
Naming.Decl.Attributes,
In_Tree);
Casing : Casing_Type := All_Lower_Case;
-- Casing type (junk initialization to stop bad gcc warning)
Casing_Defined : Boolean := False;
Sep_Suffix : constant Variable_Value :=
Prj.Util.Value_Of
(Variable_Name => Name_Separate_Suffix,
In_Variables => Naming.Decl.Attributes,
In_Tree => In_Tree);
Separate_Suffix : File_Name_Type := No_File; Separate_Suffix : File_Name_Type := No_File;
Sep_Suffix_Loc : Source_Ptr := No_Location;
Casing : Casing_Type := All_Lower_Case;
Casing_Defined : Boolean;
Lang_Id : Language_Index; Lang_Id : Language_Index;
begin begin
-- Check attribute Dot_Replacement Check_Common
(Dot_Replacement => Dot_Replacement,
if not Dot_Repl.Default then Casing => Casing,
Get_Name_String (Dot_Repl.Value); Casing_Defined => Casing_Defined,
Separate_Suffix => Separate_Suffix,
if Name_Len = 0 then Sep_Suffix_Loc => Sep_Suffix_Loc);
Error_Msg
(Project, In_Tree,
"Dot_Replacement cannot be empty",
Dot_Repl.Location);
else
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Dot_Replacement := Name_Find;
if Current_Verbosity = High then
Write_Str (" Dot_Replacement = """);
Write_Str (Get_Name_String (Dot_Replacement));
Write_Char ('"');
Write_Eol;
end if;
end if;
end if;
-- Check attribute Casing
if not Casing_String.Default then
declare
Casing_Image : constant String :=
Get_Name_String (Casing_String.Value);
begin
declare
Casing_Value : constant Casing_Type :=
Value (Casing_Image);
begin
Casing := Casing_Value;
Casing_Defined := True;
if Current_Verbosity = High then
Write_Str (" Casing = ");
Write_Str (Image (Casing));
Write_Char ('.');
Write_Eol;
end if;
end;
exception
when Constraint_Error =>
if Casing_Image'Length = 0 then
Error_Msg
(Project, In_Tree,
"Casing cannot be an empty string",
Casing_String.Location);
else
Name_Len := Casing_Image'Length;
Name_Buffer (1 .. Name_Len) := Casing_Image;
Err_Vars.Error_Msg_Name_1 := Name_Find;
Error_Msg
(Project, In_Tree,
"%% is not a correct Casing",
Casing_String.Location);
end if;
end;
end if;
if not Sep_Suffix.Default then
Get_Name_String (Sep_Suffix.Value);
if Name_Len = 0 then
Error_Msg
(Project, In_Tree,
"Separate_Suffix cannot be empty",
Sep_Suffix.Location);
else
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Separate_Suffix := Name_Find;
if Current_Verbosity = High then
Write_Str (" Separate_Suffix = """);
Write_Str (Get_Name_String (Separate_Suffix));
Write_Char ('"');
Write_Eol;
end if;
end if;
end if;
-- For all unit based languages, if any, set the specified -- For all unit based languages, if any, set the specified
-- value of Dot_Replacement, Casing and/or Separate_Suffix. -- value of Dot_Replacement, Casing and/or Separate_Suffix. Do not
-- systematically overwrite, since the defaults come from the
-- configuration file
if Dot_Replacement /= No_File if Dot_Replacement /= No_File
or else Casing_Defined or else Casing_Defined
...@@ -3617,8 +3464,25 @@ package body Prj.Nmsc is ...@@ -3617,8 +3464,25 @@ package body Prj.Nmsc is
Get_Unit_Exceptions (Spec); Get_Unit_Exceptions (Spec);
Get_Unit_Exceptions (Impl); Get_Unit_Exceptions (Impl);
end Check_Naming_Multi_Lang;
-- Start of processing for Check_Naming_Schemes
begin
-- No Naming package or parsing a configuration file ? nothing to do
if Naming_Id /= No_Package and not In_Configuration then
Naming := In_Tree.Packages.Table (Naming_Id);
if Current_Verbosity = High then
Write_Line ("Checking package Naming.");
end if; end if;
case Get_Mode is
when Ada_Only =>
Check_Naming_Ada_Only;
when Multi_Language =>
Check_Naming_Multi_Lang;
end case;
end if; end if;
end Check_Naming_Schemes; end Check_Naming_Schemes;
...@@ -3819,9 +3683,7 @@ package body Prj.Nmsc is ...@@ -3819,9 +3683,7 @@ package body Prj.Nmsc is
if Data.Library_Name /= No_Name then if Data.Library_Name /= No_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Library name = """); Write_Attr ("Library name", Get_Name_String (Data.Library_Name));
Write_Str (Get_Name_String (Data.Library_Name));
Write_Line ("""");
end if; end if;
pragma Assert (Lib_Dir.Kind = Single); pragma Assert (Lib_Dir.Kind = Single);
...@@ -3969,10 +3831,9 @@ package body Prj.Nmsc is ...@@ -3969,10 +3831,9 @@ package body Prj.Nmsc is
-- Display the Library directory in high verbosity -- Display the Library directory in high verbosity
Write_Str ("Library directory ="""); Write_Attr
Write_Str ("Library directory",
(Get_Name_String (Data.Library_Dir.Display_Name)); Get_Name_String (Data.Library_Dir.Display_Name));
Write_Line ("""");
end if; end if;
end; end;
end if; end if;
...@@ -4185,11 +4046,10 @@ package body Prj.Nmsc is ...@@ -4185,11 +4046,10 @@ package body Prj.Nmsc is
-- Display the Library ALI directory in high -- Display the Library ALI directory in high
-- verbosity. -- verbosity.
Write_Str ("Library ALI directory ="""); Write_Attr
Write_Str ("Library ALI dir",
(Get_Name_String Get_Name_String
(Data.Library_ALI_Dir.Display_Name)); (Data.Library_ALI_Dir.Display_Name));
Write_Line ("""");
end if; end if;
end; end;
end if; end if;
...@@ -4242,8 +4102,7 @@ package body Prj.Nmsc is ...@@ -4242,8 +4102,7 @@ package body Prj.Nmsc is
end if; end if;
if Current_Verbosity = High and then OK then if Current_Verbosity = High and then OK then
Write_Str ("Library kind = "); Write_Attr ("Library kind", Kind_Name);
Write_Line (Kind_Name);
end if; end if;
if Data.Library_Kind /= Static then if Data.Library_Kind /= Static then
...@@ -5351,9 +5210,9 @@ package body Prj.Nmsc is ...@@ -5351,9 +5210,9 @@ package body Prj.Nmsc is
if Data.Library_Src_Dir /= No_Path_Information if Data.Library_Src_Dir /= No_Path_Information
and then Current_Verbosity = High and then Current_Verbosity = High
then then
Write_Str ("Directory to copy interfaces ="""); Write_Attr
Write_Str (Get_Name_String (Data.Library_Src_Dir.Name)); ("Directory to copy interfaces",
Write_Line (""""); Get_Name_String (Data.Library_Src_Dir.Name));
end if; end if;
end if; end if;
end; end;
...@@ -5766,8 +5625,7 @@ package body Prj.Nmsc is ...@@ -5766,8 +5625,7 @@ package body Prj.Nmsc is
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Source_Dir = "); Write_Attr ("Source_Dir", Source_Directory);
Write_Line (Source_Directory);
end if; end if;
-- We look at every entry in the source directory -- We look at every entry in the source directory
...@@ -5957,14 +5815,8 @@ package body Prj.Nmsc is ...@@ -5957,14 +5815,8 @@ package body Prj.Nmsc is
Name_Buffer (1 .. Name_Len) := Name_Buffer (1 .. Name_Len) :=
The_Path (The_Path'First .. The_Path_Last); The_Path (The_Path'First .. The_Path_Last);
Non_Canonical_Path := Name_Find; Non_Canonical_Path := Name_Find;
Canonical_Path :=
if Osint.File_Names_Case_Sensitive then Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
Canonical_Path := Non_Canonical_Path;
else
Get_Name_String (Non_Canonical_Path);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Canonical_Path := Name_Find;
end if;
-- To avoid processing the same directory several times, check -- To avoid processing the same directory several times, check
-- if the directory is already in Recursive_Dirs. If it is, then -- if the directory is already in Recursive_Dirs. If it is, then
...@@ -6386,15 +6238,8 @@ package body Prj.Nmsc is ...@@ -6386,15 +6238,8 @@ package body Prj.Nmsc is
Data.Object_Directory.Display_Name := Data.Object_Directory.Display_Name :=
Path_Name_Type (Object_Dir.Value); Path_Name_Type (Object_Dir.Value);
if Osint.File_Names_Case_Sensitive then
Data.Object_Directory.Name := Data.Object_Directory.Name :=
Path_Name_Type (Object_Dir.Value); Path_Name_Type (Canonical_Case_File_Name (Object_Dir.Value));
else
Get_Name_String (Object_Dir.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Data.Object_Directory.Name := Name_Find;
end if;
end if; end if;
end if; end if;
...@@ -6420,9 +6265,9 @@ package body Prj.Nmsc is ...@@ -6420,9 +6265,9 @@ package body Prj.Nmsc is
if Data.Object_Directory = No_Path_Information then if Data.Object_Directory = No_Path_Information then
Write_Line ("No object directory"); Write_Line ("No object directory");
else else
Write_Str ("Object directory: """); Write_Attr
Write_Str (Get_Name_String (Data.Object_Directory.Display_Name)); ("Object directory",
Write_Line (""""); Get_Name_String (Data.Object_Directory.Display_Name));
end if; end if;
end if; end if;
...@@ -6515,10 +6360,9 @@ package body Prj.Nmsc is ...@@ -6515,10 +6360,9 @@ package body Prj.Nmsc is
Index => 0); Index => 0);
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line ("Single source directory:"); Write_Attr
Write_Str (" """); ("Single source directory",
Write_Str (Get_Name_String (Data.Directory.Display_Name)); Get_Name_String (Data.Directory.Display_Name));
Write_Line ("""");
end if; end if;
elsif Source_Dirs.Values = Nil_String then elsif Source_Dirs.Values = Nil_String then
...@@ -6584,12 +6428,8 @@ package body Prj.Nmsc is ...@@ -6584,12 +6428,8 @@ package body Prj.Nmsc is
while Current /= Nil_String loop while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current); Element := In_Tree.String_Elements.Table (Current);
if Element.Value /= No_Name then if Element.Value /= No_Name then
if not Osint.File_Names_Case_Sensitive then Element.Value :=
Get_Name_String (Element.Value); Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Element.Value := Name_Find;
end if;
In_Tree.String_Elements.Table (Current) := Element; In_Tree.String_Elements.Table (Current) := Element;
end if; end if;
...@@ -7256,32 +7096,20 @@ package body Prj.Nmsc is ...@@ -7256,32 +7096,20 @@ package body Prj.Nmsc is
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Data : Project_Data) Data : Project_Data)
is is
Excluded_Sources : Variable_Value; Excluded_Source_List_File : constant Variable_Value := Util.Value_Of
(Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
Excluded_Source_List_File : Variable_Value; Excluded_Sources : Variable_Value := Util.Value_Of
(Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
Current : String_List_Id; Current : String_List_Id;
Element : String_Element; Element : String_Element;
Location : Source_Ptr; Location : Source_Ptr;
Name : File_Name_Type; Name : File_Name_Type;
File : Prj.Util.Text_File; File : Prj.Util.Text_File;
Line : String (1 .. 300); Line : String (1 .. 300);
Last : Natural; Last : Natural;
Locally_Removed : Boolean := False; Locally_Removed : Boolean := False;
begin begin
Excluded_Source_List_File :=
Util.Value_Of
(Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
Excluded_Sources :=
Util.Value_Of
(Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
-- If Excluded_Source_Files is not declared, check -- If Excluded_Source_Files is not declared, check
-- Locally_Removed_Files. -- Locally_Removed_Files.
...@@ -7316,14 +7144,7 @@ package body Prj.Nmsc is ...@@ -7316,14 +7144,7 @@ package body Prj.Nmsc is
Current := Excluded_Sources.Values; Current := Excluded_Sources.Values;
while Current /= Nil_String loop while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current); Element := In_Tree.String_Elements.Table (Current);
Name := Canonical_Case_File_Name (Element.Value);
if Osint.File_Names_Case_Sensitive then
Name := File_Name_Type (Element.Value);
else
Get_Name_String (Element.Value);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
end if;
-- If the element has no location, then use the location -- If the element has no location, then use the location
-- of Excluded_Sources to report possible errors. -- of Excluded_Sources to report possible errors.
...@@ -7483,15 +7304,9 @@ package body Prj.Nmsc is ...@@ -7483,15 +7304,9 @@ package body Prj.Nmsc is
while Current /= Nil_String loop while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current); Element := In_Tree.String_Elements.Table (Current);
Name := Canonical_Case_File_Name (Element.Value);
Get_Name_String (Element.Value); Get_Name_String (Element.Value);
if Osint.File_Names_Case_Sensitive then
Name := File_Name_Type (Element.Value);
else
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Name := Name_Find;
end if;
-- If the element has no location, then use the -- If the element has no location, then use the
-- location of Sources to report possible errors. -- location of Sources to report possible errors.
...@@ -8518,8 +8333,7 @@ package body Prj.Nmsc is ...@@ -8518,8 +8333,7 @@ package body Prj.Nmsc is
begin begin
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Str ("Source_Dir = "); Write_Attr ("Source_Dir", Source_Directory);
Write_Line (Source_Directory);
end if; end if;
-- We look to every entry in the source directory -- We look to every entry in the source directory
...@@ -8900,21 +8714,21 @@ package body Prj.Nmsc is ...@@ -8900,21 +8714,21 @@ package body Prj.Nmsc is
Source_Names.Reset; Source_Names.Reset;
Find_Excluded_Sources (Project, In_Tree, Data); Find_Excluded_Sources (Project, In_Tree, Data);
case Get_Mode is if (Get_Mode = Ada_Only and then Is_A_Language (In_Tree, Data, Name_Ada))
when Ada_Only => or else (Get_Mode = Multi_Language
if Is_A_Language (In_Tree, Data, Name_Ada) then and then Data.First_Language_Processing /= No_Language_Index)
Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data); then
Mark_Excluded_Sources; if Get_Mode = Multi_Language then
Load_Naming_Exceptions (Project, In_Tree, Data);
end if; end if;
when Multi_Language =>
if Data.First_Language_Processing /= No_Language_Index then
Load_Naming_Exceptions (Project, In_Tree, Data);
Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data); Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
Mark_Excluded_Sources; Mark_Excluded_Sources;
if Get_Mode = Multi_Language then
Process_Sources_In_Multi_Language_Mode; Process_Sources_In_Multi_Language_Mode;
end if; end if;
end case; end if;
end Look_For_Sources; end Look_For_Sources;
------------------ ------------------
...@@ -9024,14 +8838,11 @@ package body Prj.Nmsc is ...@@ -9024,14 +8838,11 @@ package body Prj.Nmsc is
File_Name_Recorded : Boolean := False; File_Name_Recorded : Boolean := False;
begin begin
Canonical_File_Name := Canonical_Case_File_Name (Name_Id (File_Name));
if Osint.File_Names_Case_Sensitive then if Osint.File_Names_Case_Sensitive then
Canonical_File_Name := File_Name;
Canonical_Path_Name := Path_Name; Canonical_Path_Name := Path_Name;
else else
Get_Name_String (File_Name);
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
Canonical_File_Name := Name_Find;
declare declare
Canonical_Path : constant String := Canonical_Path : constant String :=
Normalize_Pathname Normalize_Pathname
......
gcc/ada/prj-proc.adb
...@@ -2519,7 +2519,67 @@ package body Prj.Proc is ...@@ -2519,7 +2519,67 @@ package body Prj.Proc is
From_Project_Node_Tree : Project_Node_Tree_Ref; From_Project_Node_Tree : Project_Node_Tree_Ref;
Extended_By : Project_Id) Extended_By : Project_Id)
is is
With_Clause : Project_Node_Id; procedure Process_Imported_Projects
(Imported : in out Project_List;
Limited_With : Boolean);
-- Process imported projects. If Limited_With is True, then only
-- projects processed through a "limited with" are processed, otherwise
-- only projects imported through a standard "with" are processed.
-- Imported is the id of the last imported project.
procedure Process_Imported_Projects
(Imported : in out Project_List;
Limited_With : Boolean)
is
With_Clause : Project_Node_Id := First_With_Clause_Of
(From_Project_Node, From_Project_Node_Tree);
New_Project : Project_Id;
Proj_Node : Project_Node_Id;
begin
while Present (With_Clause) loop
Proj_Node :=
Non_Limited_Project_Node_Of
(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))
then
Recursive_Process
(In_Tree => In_Tree,
Project => New_Project,
From_Project_Node =>
Project_Node_Of
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
-- Add this project to our list of imported projects
Project_List_Table.Increment_Last (In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last (In_Tree.Project_Lists)) :=
(Project => New_Project, Next => Empty_Project_List);
-- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first.
if Imported = Empty_Project_List then
In_Tree.Projects.Table (Project).Imported_Projects :=
Project_List_Table.Last (In_Tree.Project_Lists);
else
In_Tree.Project_Lists.Table (Imported).Next :=
Project_List_Table.Last (In_Tree.Project_Lists);
end if;
Imported := Project_List_Table.Last (In_Tree.Project_Lists);
end if;
With_Clause :=
Next_With_Clause_Of (With_Clause, From_Project_Node_Tree);
end loop;
end Process_Imported_Projects;
begin begin
if No (From_Project_Node) then if No (From_Project_Node) then
...@@ -2624,68 +2684,9 @@ package body Prj.Proc is ...@@ -2624,68 +2684,9 @@ package body Prj.Proc is
Prj.Attr.Attribute_First, Prj.Attr.Attribute_First,
Project_Level => True); Project_Level => True);
-- Process non limited withed projects In_Tree.Projects.Table (Project) := Processed_Data;
With_Clause :=
First_With_Clause_Of (From_Project_Node, From_Project_Node_Tree);
while Present (With_Clause) loop
declare
New_Project : Project_Id;
New_Data : Project_Data;
pragma Unreferenced (New_Data);
Proj_Node : Project_Node_Id;
begin
Proj_Node :=
Non_Limited_Project_Node_Of
(With_Clause, From_Project_Node_Tree);
if Present (Proj_Node) then
Recursive_Process
(In_Tree => In_Tree,
Project => New_Project,
From_Project_Node =>
Project_Node_Of
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
New_Data :=
In_Tree.Projects.Table (New_Project);
-- Add this project to our list of imported projects
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => New_Project, Next => Empty_Project_List);
-- Imported is the id of the last imported project. If it
-- is nil, then this imported project is our first.
if Imported = Empty_Project_List then
Processed_Data.Imported_Projects :=
Project_List_Table.Last
(In_Tree.Project_Lists);
else
In_Tree.Project_Lists.Table
(Imported).Next := Project_List_Table.Last
(In_Tree.Project_Lists);
end if;
Imported := Project_List_Table.Last
(In_Tree.Project_Lists);
end if;
With_Clause := Process_Imported_Projects (Imported, Limited_With => False);
Next_With_Clause_Of
(With_Clause, From_Project_Node_Tree);
end;
end loop;
Declaration_Node := Declaration_Node :=
Project_Declaration_Of Project_Declaration_Of
...@@ -2693,15 +2694,13 @@ package body Prj.Proc is ...@@ -2693,15 +2694,13 @@ package body Prj.Proc is
Recursive_Process Recursive_Process
(In_Tree => In_Tree, (In_Tree => In_Tree,
Project => Processed_Data.Extends, Project => In_Tree.Projects.Table (Project).Extends,
From_Project_Node => Extended_Project_Of From_Project_Node => Extended_Project_Of
(Declaration_Node, (Declaration_Node,
From_Project_Node_Tree), From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree, From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => Project); Extended_By => Project);
In_Tree.Projects.Table (Project) := Processed_Data;
Process_Declarative_Items Process_Declarative_Items
(Project => Project, (Project => Project,
In_Tree => In_Tree, In_Tree => In_Tree,
...@@ -2826,68 +2825,7 @@ package body Prj.Proc is ...@@ -2826,68 +2825,7 @@ package body Prj.Proc is
In_Tree.Projects.Table (Project) := Processed_Data; In_Tree.Projects.Table (Project) := Processed_Data;
end if; end if;
-- Process limited withed projects Process_Imported_Projects (Imported, Limited_With => True);
With_Clause :=
First_With_Clause_Of
(From_Project_Node, From_Project_Node_Tree);
while Present (With_Clause) loop
declare
New_Project : Project_Id;
New_Data : Project_Data;
pragma Unreferenced (New_Data);
Proj_Node : Project_Node_Id;
begin
Proj_Node :=
Non_Limited_Project_Node_Of
(With_Clause, From_Project_Node_Tree);
if No (Proj_Node) then
Recursive_Process
(In_Tree => In_Tree,
Project => New_Project,
From_Project_Node =>
Project_Node_Of
(With_Clause, From_Project_Node_Tree),
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
New_Data :=
In_Tree.Projects.Table (New_Project);
-- Add this project to our list of imported projects
Project_List_Table.Increment_Last
(In_Tree.Project_Lists);
In_Tree.Project_Lists.Table
(Project_List_Table.Last
(In_Tree.Project_Lists)) :=
(Project => New_Project, Next => Empty_Project_List);
-- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first.
if Imported = Empty_Project_List then
In_Tree.Projects.Table (Project).Imported_Projects :=
Project_List_Table.Last
(In_Tree.Project_Lists);
else
In_Tree.Project_Lists.Table
(Imported).Next := Project_List_Table.Last
(In_Tree.Project_Lists);
end if;
Imported := Project_List_Table.Last
(In_Tree.Project_Lists);
end if;
With_Clause :=
Next_With_Clause_Of
(With_Clause, From_Project_Node_Tree);
end;
end loop;
end; end;
end if; end if;
end Recursive_Process; end Recursive_Process;
......
gcc/ada/prj.adb
...@@ -73,7 +73,6 @@ package body Prj is ...@@ -73,7 +73,6 @@ package body Prj is
Std_Naming_Data : constant Naming_Data := Std_Naming_Data : constant Naming_Data :=
(Dot_Replacement => Standard_Dot_Replacement, (Dot_Replacement => Standard_Dot_Replacement,
Dot_Repl_Loc => No_Location,
Casing => All_Lower_Case, Casing => All_Lower_Case,
Spec_Suffix => No_Array_Element, Spec_Suffix => No_Array_Element,
Ada_Spec_Suffix_Loc => No_Location, Ada_Spec_Suffix_Loc => No_Location,
...@@ -655,10 +654,9 @@ package body Prj is ...@@ -655,10 +654,9 @@ package body Prj is
Extended : Project_Id; Extended : Project_Id;
In_Tree : Project_Tree_Ref) return Boolean In_Tree : Project_Tree_Ref) return Boolean
is is
Proj : Project_Id; Proj : Project_Id := Extending;
begin begin
Proj := Extending;
while Proj /= No_Project loop while Proj /= No_Project loop
if Proj = Extended then if Proj = Extended then
return True; return True;
......
gcc/ada/prj.ads
...@@ -870,8 +870,6 @@ package Prj is ...@@ -870,8 +870,6 @@ package Prj is
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
-- The string to replace '.' in the source file name (for Ada) -- The string to replace '.' in the source file name (for Ada)
Dot_Repl_Loc : Source_Ptr := No_Location;
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
-- The casing of the source file name (for Ada) -- The casing of the source file name (for Ada)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment