Skip to content

R
riscv-gcc-1
Commit 39d4e04a by Emmanuel Briot Committed by Arnaud Charlet
Options

prj.adb, [...] (Project_Data.Unit_Based_Language_*): Two fields removed. 

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

	* prj.adb, prj.ads, prj-nmsc.adb (Project_Data.Unit_Based_Language_*):
	Two fields removed.

From-SVN: r146582
parent 09f2a1e4
Showing with 73 additions and 109 deletions
gcc/ada/ChangeLog
2009-04-22 Emmanuel Briot <briot@adacore.com> 2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Project_Data.Unit_Based_Language_*):
Two fields removed.
2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the * prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the
separate_suffix to the same value as the body_suffix. separate_suffix to the same value as the body_suffix.
......
gcc/ada/prj-nmsc.adb
...@@ -2807,12 +2807,6 @@ package body Prj.Nmsc is ...@@ -2807,12 +2807,6 @@ 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 Get_Exceptions (Kind : Source_Kind);
-- Comment required ???
procedure Get_Unit_Exceptions (Kind : Source_Kind);
-- Comment required ???
procedure Check_Naming_Ada_Only; procedure Check_Naming_Ada_Only;
-- Does Check_Naming_Schemes processing in Ada_Only mode. -- Does Check_Naming_Schemes processing in Ada_Only mode.
-- If there is a package Naming, puts in Data.Naming the contents of -- If there is a package Naming, puts in Data.Naming the contents of
...@@ -2829,6 +2823,15 @@ package body Prj.Nmsc is ...@@ -2829,6 +2823,15 @@ package body Prj.Nmsc is
Sep_Suffix_Loc : out Source_Ptr); Sep_Suffix_Loc : out Source_Ptr);
-- Check attributes common to Ada_Only and Multi_Lang modes -- Check attributes common to Ada_Only and Multi_Lang modes
procedure Process_Exceptions_File_Based
(Lang_Id : Language_Index;
Kind : Source_Kind);
procedure Process_Exceptions_Unit_Based
(Lang_Id : Language_Index;
Kind : Source_Kind);
-- In Multi_Lang mode, process the naming exceptions for the two types
-- of languages we can have.
------------------ ------------------
-- Check_Common -- -- Check_Common --
------------------ ------------------
...@@ -2970,45 +2973,38 @@ package body Prj.Nmsc is ...@@ -2970,45 +2973,38 @@ package body Prj.Nmsc is
end if; end if;
end Check_Common; end Check_Common;
-------------------- -----------------------------------
-- Get_Exceptions -- -- Process_Exceptions_File_Based --
-------------------- -----------------------------------
procedure Get_Exceptions (Kind : Source_Kind) is procedure Process_Exceptions_File_Based
(Lang_Id : Language_Index;
Kind : Source_Kind)
is
Lang : constant Name_Id :=
In_Tree.Languages_Data.Table (Lang_Id).Name;
Exceptions : Array_Element_Id; Exceptions : Array_Element_Id;
Exception_List : Variable_Value; Exception_List : Variable_Value;
Element_Id : String_List_Id; Element_Id : String_List_Id;
Element : String_Element; Element : String_Element;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Lang_Id : Language_Index;
Lang : Name_Id;
Lang_Kind : Language_Kind;
Source : Source_Id; Source : Source_Id;
begin begin
if Kind = Impl then case Kind is
when Impl | Sep =>
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Implementation_Exceptions, (Name_Implementation_Exceptions,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
else when Spec =>
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Specification_Exceptions, (Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end case;
Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop
if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
File_Based
then
Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
Lang_Kind :=
In_Tree.Languages_Data.Table (Lang_Id).Config.Kind;
Exception_List := Value_Of Exception_List := Value_Of
(Index => Lang, (Index => Lang,
...@@ -3023,11 +3019,9 @@ package body Prj.Nmsc is ...@@ -3023,11 +3019,9 @@ package body Prj.Nmsc is
Source := Data.First_Source; Source := Data.First_Source;
while Source /= No_Source while Source /= No_Source
and then and then In_Tree.Sources.Table (Source).File /= File_Name
In_Tree.Sources.Table (Source).File /= File_Name
loop loop
Source := Source := In_Tree.Sources.Table (Source).Next_In_Project;
In_Tree.Sources.Table (Source).Next_In_Project;
end loop; end loop;
if Source = No_Source then if Source = No_Source then
...@@ -3042,28 +3036,24 @@ package body Prj.Nmsc is ...@@ -3042,28 +3036,24 @@ package body Prj.Nmsc is
File_Name => File_Name, File_Name => File_Name,
Display_File => File_Name_Type (Element.Value), Display_File => File_Name_Type (Element.Value),
Naming_Exception => True, Naming_Exception => True,
Lang_Kind => Lang_Kind); Lang_Kind => File_Based);
else else
-- Check if the file name is already recorded for -- Check if the file name is already recorded for another
-- another language or another kind. -- language or another kind.
if if In_Tree.Sources.Table (Source).Language /= Lang_Id then
In_Tree.Sources.Table (Source).Language /= Lang_Id
then
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
"the same file cannot be a source " & "the same file cannot be a source of two languages",
"of two languages",
Element.Location); Element.Location);
elsif In_Tree.Sources.Table (Source).Kind /= Kind then elsif In_Tree.Sources.Table (Source).Kind /= Kind then
Error_Msg Error_Msg
(Project, (Project,
In_Tree, In_Tree,
"the same file cannot be a source " & "the same file cannot be a source and a template",
"and a template",
Element.Location); Element.Location);
end if; end if;
...@@ -3071,45 +3061,35 @@ package body Prj.Nmsc is ...@@ -3071,45 +3061,35 @@ package body Prj.Nmsc is
-- language and the same kind, it means that the file -- language and the same kind, it means that the file
-- name appears several times in the *_Exceptions -- name appears several times in the *_Exceptions
-- attribute; so there is nothing to do. -- attribute; so there is nothing to do.
end if; end if;
Element_Id := Element.Next; Element_Id := Element.Next;
end loop; end loop;
end if; end if;
end if; end Process_Exceptions_File_Based;
Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next; -----------------------------------
end loop; -- Process_Exceptions_Unit_Based --
end Get_Exceptions; -----------------------------------
-------------------------
-- Get_Unit_Exceptions --
-------------------------
procedure Get_Unit_Exceptions (Kind : Source_Kind) is procedure Process_Exceptions_Unit_Based
(Lang_Id : Language_Index;
Kind : Source_Kind)
is
Lang : constant Name_Id :=
In_Tree.Languages_Data.Table (Lang_Id).Name;
Exceptions : Array_Element_Id; Exceptions : Array_Element_Id;
Element : Array_Element; Element : Array_Element;
Unit : Name_Id; Unit : Name_Id;
Index : Int; Index : Int;
File_Name : File_Name_Type; File_Name : File_Name_Type;
Lang_Id : constant Language_Index :=
Data.Unit_Based_Language_Index;
Lang : constant Name_Id :=
Data.Unit_Based_Language_Name;
Source : Source_Id; Source : Source_Id;
Source_To_Replace : Source_Id := No_Source; Source_To_Replace : Source_Id := No_Source;
Other_Project : Project_Id; Other_Project : Project_Id;
Other_Part : Source_Id := No_Source; Other_Part : Source_Id := No_Source;
begin begin
if Lang_Id = No_Language_Index or else Lang = No_Name then case Kind is
return; when Impl | Sep =>
end if;
if Kind = Impl then
Exceptions := Value_Of Exceptions := Value_Of
(Name_Body, (Name_Body,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
...@@ -3123,7 +3103,7 @@ package body Prj.Nmsc is ...@@ -3123,7 +3103,7 @@ package body Prj.Nmsc is
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end if;
else when Spec =>
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Spec, (Name_Spec,
...@@ -3136,8 +3116,7 @@ package body Prj.Nmsc is ...@@ -3136,8 +3116,7 @@ package body Prj.Nmsc is
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
end if; end if;
end case;
end if;
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);
...@@ -3146,7 +3125,6 @@ package body Prj.Nmsc is ...@@ -3146,7 +3125,6 @@ package body Prj.Nmsc is
Get_Name_String (Element.Index); Get_Name_String (Element.Index);
To_Lower (Name_Buffer (1 .. Name_Len)); To_Lower (Name_Buffer (1 .. Name_Len));
Unit := Name_Find; Unit := Name_Find;
Index := Element.Value.Index; Index := Element.Value.Index;
-- For Ada, check if it is a valid unit name -- For Ada, check if it is a valid unit name
...@@ -3240,7 +3218,7 @@ package body Prj.Nmsc is ...@@ -3240,7 +3218,7 @@ package body Prj.Nmsc is
Exceptions := Element.Next; Exceptions := Element.Next;
end loop; end loop;
end Get_Unit_Exceptions; end Process_Exceptions_Unit_Based;
--------------------------- ---------------------------
-- Check_Naming_Ada_Only -- -- Check_Naming_Ada_Only --
...@@ -3377,22 +3355,14 @@ package body Prj.Nmsc is ...@@ -3377,22 +3355,14 @@ package body Prj.Nmsc is
----------------------------- -----------------------------
procedure Check_Naming_Multi_Lang is procedure Check_Naming_Multi_Lang is
begin
-- We are now checking if attribute Dot_Replacement, Casing, and/or
-- Separate_Suffix exist.
-- For each attribute, if it does not exist, we do nothing, because
-- we already have the default. Otherwise, for all unit-based
-- languages, we put the declared value in the language config.
declare
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
Separate_Suffix : File_Name_Type := No_File; Separate_Suffix : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case; Casing : Casing_Type := All_Lower_Case;
Casing_Defined : Boolean; Casing_Defined : Boolean;
Lang_Id : Language_Index; Lang_Id : Language_Index;
Sep_Suffix_Loc : Source_Ptr; Sep_Suffix_Loc : Source_Ptr;
Suffix : Variable_Value;
Lang : Name_Id;
begin begin
Check_Common Check_Common
(Dot_Replacement => Dot_Replacement, (Dot_Replacement => Dot_Replacement,
...@@ -3401,8 +3371,8 @@ package body Prj.Nmsc is ...@@ -3401,8 +3371,8 @@ package body Prj.Nmsc is
Separate_Suffix => Separate_Suffix, Separate_Suffix => Separate_Suffix,
Sep_Suffix_Loc => Sep_Suffix_Loc); Sep_Suffix_Loc => Sep_Suffix_Loc);
-- For all unit based languages, if any, set the specified value -- For all unit based languages, if any, set the specified
-- of Dot_Replacement, Casing and/or Separate_Suffix. Do not -- value of Dot_Replacement, Casing and/or Separate_Suffix. Do not
-- systematically overwrite, since the defaults come from the -- systematically overwrite, since the defaults come from the
-- configuration file -- configuration file
...@@ -3437,16 +3407,9 @@ package body Prj.Nmsc is ...@@ -3437,16 +3407,9 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table (Lang_Id).Next; In_Tree.Languages_Data.Table (Lang_Id).Next;
end loop; end loop;
end if; end if;
end;
-- Next, get the spec and body suffixes -- Next, get the spec and body suffixes
declare
Suffix : Variable_Value;
Lang_Id : Language_Index;
Lang : Name_Id;
begin
Lang_Id := Data.First_Language_Processing; Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop while Lang_Id /= No_Language_Index loop
Lang := In_Tree.Languages_Data.Table (Lang_Id).Name; Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
...@@ -3503,17 +3466,23 @@ package body Prj.Nmsc is ...@@ -3503,17 +3466,23 @@ package body Prj.Nmsc is
Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next; Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
end loop; end loop;
end;
-- Get the exceptions for file based languages -- Get the naming exceptions for all languages
Get_Exceptions (Spec); for Kind in Spec .. Impl loop
Get_Exceptions (Impl); Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop
case In_Tree.Languages_Data.Table (Lang_Id).Config.Kind is
when File_Based =>
Process_Exceptions_File_Based (Lang_Id, Kind);
-- Get the exceptions for unit based languages when Unit_Based =>
Process_Exceptions_Unit_Based (Lang_Id, Kind);
end case;
Get_Unit_Exceptions (Spec); Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
Get_Unit_Exceptions (Impl); end loop;
end loop;
end Check_Naming_Multi_Lang; end Check_Naming_Multi_Lang;
-- Start of processing for Check_Naming_Schemes -- Start of processing for Check_Naming_Schemes
...@@ -4578,9 +4547,6 @@ package body Prj.Nmsc is ...@@ -4578,9 +4547,6 @@ package body Prj.Nmsc is
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Data.First_Language_Processing).Config.Dependency_Kind (Data.First_Language_Processing).Config.Dependency_Kind
:= ALI_File; := ALI_File;
Data.Unit_Based_Language_Name := Name_Ada;
Data.Unit_Based_Language_Index :=
Data.First_Language_Processing;
else else
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Data.First_Language_Processing).Config.Kind (Data.First_Language_Processing).Config.Kind
...@@ -4680,8 +4646,6 @@ package body Prj.Nmsc is ...@@ -4680,8 +4646,6 @@ package body Prj.Nmsc is
if Lang_Name = Name_Ada then if Lang_Name = Name_Ada then
Lang_Data.Config.Kind := Unit_Based; Lang_Data.Config.Kind := Unit_Based;
Lang_Data.Config.Dependency_Kind := ALI_File; Lang_Data.Config.Dependency_Kind := ALI_File;
Data.Unit_Based_Language_Name := Name_Ada;
Data.Unit_Based_Language_Index := Index;
else else
Lang_Data.Config.Kind := File_Based; Lang_Data.Config.Kind := File_Based;
......
gcc/ada/prj.adb
...@@ -113,8 +113,6 @@ package body Prj is ...@@ -113,8 +113,6 @@ package body Prj is
First_Source => No_Source, First_Source => No_Source,
Last_Source => No_Source, Last_Source => No_Source,
Interfaces_Defined => False, Interfaces_Defined => False,
Unit_Based_Language_Name => No_Name,
Unit_Based_Language_Index => No_Language_Index,
Imported_Directories_Switches => null, Imported_Directories_Switches => null,
Include_Path => null, Include_Path => null,
Include_Data_Set => False, Include_Data_Set => False,
......
gcc/ada/prj.ads
...@@ -888,11 +888,11 @@ package Prj is ...@@ -888,11 +888,11 @@ package Prj is
Specs : Array_Element_Id := No_Array_Element; Specs : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual specs to source file names -- An associative array mapping individual specs to source file names
-- This is specific to Ada. -- This is specific to unit-based languages.
Bodies : Array_Element_Id := No_Array_Element; Bodies : Array_Element_Id := No_Array_Element;
-- An associative array mapping individual bodies to source file names -- An associative array mapping individual bodies to source file names
-- This is specific to Ada. -- This is specific to unit-based languages.
Specification_Exceptions : Array_Element_Id := No_Array_Element; Specification_Exceptions : Array_Element_Id := No_Array_Element;
-- An associative array listing spec file names that do not have the -- An associative array listing spec file names that do not have the
...@@ -1179,17 +1179,14 @@ package Prj is ...@@ -1179,17 +1179,14 @@ package Prj is
Languages : Name_List_Index := No_Name_List; Languages : Name_List_Index := No_Name_List;
-- The list of languages of the sources of this project -- The list of languages of the sources of this project
-- mode: Ada_Only
Include_Language : Language_Index := No_Language_Index; Include_Language : Language_Index := No_Language_Index;
First_Language_Processing : Language_Index := No_Language_Index; First_Language_Processing : Language_Index := No_Language_Index;
-- First index of the language data in the project -- First index of the language data in the project.
-- This is an index into the project_tree_data.languages_data
Unit_Based_Language_Name : Name_Id := No_Name; -- mode: Multi_Language
Unit_Based_Language_Index : Language_Index := No_Language_Index;
-- The name and index, if any, of the unit-based language of some
-- sources of the project. There may be only one unit-based language
-- in one project.
-------------- --------------
-- Projects -- -- Projects --
......
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