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 233 additions and 269 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,183 +2973,158 @@ package body Prj.Nmsc is ...@@ -2970,183 +2973,158 @@ 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
Exceptions := when Impl | Sep =>
Value_Of Exceptions :=
(Name_Implementation_Exceptions, Value_Of
In_Arrays => Naming.Decl.Arrays, (Name_Implementation_Exceptions,
In_Tree => In_Tree); In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
else
Exceptions :=
Value_Of
(Name_Specification_Exceptions,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
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
(Index => Lang,
In_Array => Exceptions,
In_Tree => In_Tree);
if Exception_List /= Nil_Variable_Value then when Spec =>
Element_Id := Exception_List.Values; Exceptions :=
while Element_Id /= Nil_String loop Value_Of
Element := In_Tree.String_Elements.Table (Element_Id); (Name_Specification_Exceptions,
File_Name := Canonical_Case_File_Name (Element.Value); In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end case;
Source := Data.First_Source; Exception_List := Value_Of
while Source /= No_Source (Index => Lang,
and then In_Array => Exceptions,
In_Tree.Sources.Table (Source).File /= File_Name In_Tree => In_Tree);
loop
Source :=
In_Tree.Sources.Table (Source).Next_In_Project;
end loop;
if Source = No_Source then if Exception_List /= Nil_Variable_Value then
Add_Source Element_Id := Exception_List.Values;
(Id => Source, while Element_Id /= Nil_String loop
Data => Data, Element := In_Tree.String_Elements.Table (Element_Id);
In_Tree => In_Tree, File_Name := Canonical_Case_File_Name (Element.Value);
Project => Project,
Lang => Lang,
Lang_Id => Lang_Id,
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
Naming_Exception => True,
Lang_Kind => Lang_Kind);
else Source := Data.First_Source;
-- Check if the file name is already recorded for while Source /= No_Source
-- another language or another kind. and then In_Tree.Sources.Table (Source).File /= File_Name
loop
Source := In_Tree.Sources.Table (Source).Next_In_Project;
end loop;
if if Source = No_Source then
In_Tree.Sources.Table (Source).Language /= Lang_Id Add_Source
then (Id => Source,
Error_Msg Data => Data,
(Project, In_Tree => In_Tree,
In_Tree, Project => Project,
"the same file cannot be a source " & Lang => Lang,
"of two languages", Lang_Id => Lang_Id,
Element.Location); Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
Naming_Exception => True,
Lang_Kind => File_Based);
elsif In_Tree.Sources.Table (Source).Kind /= Kind then else
Error_Msg -- Check if the file name is already recorded for another
(Project, -- language or another kind.
In_Tree,
"the same file cannot be a source " &
"and a template",
Element.Location);
end if;
-- If the file is already recorded for the same if In_Tree.Sources.Table (Source).Language /= Lang_Id then
-- language and the same kind, it means that the file Error_Msg
-- name appears several times in the *_Exceptions (Project,
-- attribute; so there is nothing to do. In_Tree,
"the same file cannot be a source of two languages",
Element.Location);
end if; elsif In_Tree.Sources.Table (Source).Kind /= Kind then
Error_Msg
(Project,
In_Tree,
"the same file cannot be a source and a template",
Element.Location);
end if;
Element_Id := Element.Next; -- If the file is already recorded for the same
end loop; -- language and the same kind, it means that the file
-- name appears several times in the *_Exceptions
-- attribute; so there is nothing to do.
end if; end if;
end if;
Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next; Element_Id := Element.Next;
end loop; end loop;
end Get_Exceptions; end if;
end Process_Exceptions_File_Based;
-------------------------
-- Get_Unit_Exceptions --
-------------------------
procedure Get_Unit_Exceptions (Kind : Source_Kind) is
Exceptions : Array_Element_Id;
Element : Array_Element;
Unit : Name_Id;
Index : Int;
File_Name : File_Name_Type;
Lang_Id : constant Language_Index :=
Data.Unit_Based_Language_Index;
Lang : constant Name_Id :=
Data.Unit_Based_Language_Name;
-----------------------------------
-- Process_Exceptions_Unit_Based --
-----------------------------------
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;
Element : Array_Element;
Unit : Name_Id;
Index : Int;
File_Name : File_Name_Type;
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; Exceptions := Value_Of
(Name_Body,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
if Kind = Impl then if Exceptions = No_Array_Element then
Exceptions := Value_Of Exceptions :=
(Name_Body, Value_Of
In_Arrays => Naming.Decl.Arrays, (Name_Implementation,
In_Tree => In_Tree); In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
if Exceptions = No_Array_Element then when Spec =>
Exceptions := Exceptions :=
Value_Of Value_Of
(Name_Implementation, (Name_Spec,
In_Arrays => Naming.Decl.Arrays, In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree); In_Tree => In_Tree);
end if;
else
Exceptions :=
Value_Of
(Name_Spec,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
if Exceptions = No_Array_Element then
Exceptions := Value_Of
(Name_Specification,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
end if; if Exceptions = No_Array_Element then
Exceptions := Value_Of
(Name_Specification,
In_Arrays => Naming.Decl.Arrays,
In_Tree => In_Tree);
end if;
end case;
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); File_Name := Canonical_Case_File_Name (Element.Value.Value);
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,143 +3355,134 @@ package body Prj.Nmsc is ...@@ -3377,143 +3355,134 @@ package body Prj.Nmsc is
----------------------------- -----------------------------
procedure Check_Naming_Multi_Lang is procedure Check_Naming_Multi_Lang is
Dot_Replacement : File_Name_Type := No_File;
Separate_Suffix : File_Name_Type := No_File;
Casing : Casing_Type := All_Lower_Case;
Casing_Defined : Boolean;
Lang_Id : Language_Index;
Sep_Suffix_Loc : Source_Ptr;
Suffix : Variable_Value;
Lang : Name_Id;
begin begin
-- We are now checking if attribute Dot_Replacement, Casing, and/or Check_Common
-- Separate_Suffix exist. (Dot_Replacement => Dot_Replacement,
Casing => Casing,
-- For each attribute, if it does not exist, we do nothing, because Casing_Defined => Casing_Defined,
-- we already have the default. Otherwise, for all unit-based Separate_Suffix => Separate_Suffix,
-- languages, we put the declared value in the language config. Sep_Suffix_Loc => Sep_Suffix_Loc);
declare -- For all unit based languages, if any, set the specified
Dot_Replacement : File_Name_Type := No_File; -- value of Dot_Replacement, Casing and/or Separate_Suffix. Do not
Separate_Suffix : File_Name_Type := No_File; -- systematically overwrite, since the defaults come from the
Casing : Casing_Type := All_Lower_Case; -- configuration file
Casing_Defined : Boolean;
Lang_Id : Language_Index;
Sep_Suffix_Loc : Source_Ptr;
begin if Dot_Replacement /= No_File
Check_Common or else Casing_Defined
(Dot_Replacement => Dot_Replacement, or else Separate_Suffix /= No_File
Casing => Casing, then
Casing_Defined => Casing_Defined, Lang_Id := Data.First_Language_Processing;
Separate_Suffix => Separate_Suffix, while Lang_Id /= No_Language_Index loop
Sep_Suffix_Loc => Sep_Suffix_Loc); if In_Tree.Languages_Data.Table
(Lang_Id).Config.Kind = Unit_Based
-- For all unit based languages, if any, set the specified value then
-- of Dot_Replacement, Casing and/or Separate_Suffix. Do not if Dot_Replacement /= No_File then
-- systematically overwrite, since the defaults come from the In_Tree.Languages_Data.Table
-- configuration file (Lang_Id).Config.Naming_Data.Dot_Replacement :=
Dot_Replacement;
if Dot_Replacement /= No_File end if;
or else Casing_Defined
or else Separate_Suffix /= No_File
then
Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop
if In_Tree.Languages_Data.Table
(Lang_Id).Config.Kind = Unit_Based
then
if Dot_Replacement /= No_File then
In_Tree.Languages_Data.Table
(Lang_Id).Config.Naming_Data.Dot_Replacement :=
Dot_Replacement;
end if;
if Casing_Defined then if Casing_Defined then
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Lang_Id).Config.Naming_Data.Casing := Casing; (Lang_Id).Config.Naming_Data.Casing := Casing;
end if; end if;
if Separate_Suffix /= No_File then if Separate_Suffix /= No_File then
In_Tree.Languages_Data.Table In_Tree.Languages_Data.Table
(Lang_Id).Config.Naming_Data.Separate_Suffix := (Lang_Id).Config.Naming_Data.Separate_Suffix :=
Separate_Suffix; Separate_Suffix;
end if;
end if; end if;
end if;
Lang_Id := Lang_Id :=
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 Lang_Id := Data.First_Language_Processing;
Suffix : Variable_Value; while Lang_Id /= No_Language_Index loop
Lang_Id : Language_Index; Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
Lang : Name_Id;
begin -- Spec_Suffix
Lang_Id := Data.First_Language_Processing;
while Lang_Id /= No_Language_Index loop
Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
-- Spec_Suffix Suffix := Value_Of
(Name => Lang,
Attribute_Or_Array_Name => Name_Spec_Suffix,
In_Package => Naming_Id,
In_Tree => In_Tree);
if Suffix = Nil_Variable_Value then
Suffix := Value_Of Suffix := Value_Of
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Spec_Suffix, Attribute_Or_Array_Name => Name_Specification_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => In_Tree); In_Tree => In_Tree);
end if;
if Suffix = Nil_Variable_Value then if Suffix /= Nil_Variable_Value then
Suffix := Value_Of In_Tree.Languages_Data.Table (Lang_Id).
(Name => Lang, Config.Naming_Data.Spec_Suffix :=
Attribute_Or_Array_Name => Name_Specification_Suffix, File_Name_Type (Suffix.Value);
In_Package => Naming_Id, end if;
In_Tree => In_Tree);
end if;
if Suffix /= Nil_Variable_Value then -- Body_Suffix
In_Tree.Languages_Data.Table (Lang_Id).
Config.Naming_Data.Spec_Suffix :=
File_Name_Type (Suffix.Value);
end if;
-- Body_Suffix Suffix := Value_Of
(Name => Lang,
Attribute_Or_Array_Name => Name_Body_Suffix,
In_Package => Naming_Id,
In_Tree => In_Tree);
if Suffix = Nil_Variable_Value then
Suffix := Value_Of Suffix := Value_Of
(Name => Lang, (Name => Lang,
Attribute_Or_Array_Name => Name_Body_Suffix, Attribute_Or_Array_Name => Name_Implementation_Suffix,
In_Package => Naming_Id, In_Package => Naming_Id,
In_Tree => In_Tree); In_Tree => In_Tree);
end if;
if Suffix = Nil_Variable_Value then if Suffix /= Nil_Variable_Value then
Suffix := Value_Of In_Tree.Languages_Data.Table (Lang_Id).
(Name => Lang, Config.Naming_Data.Body_Suffix :=
Attribute_Or_Array_Name => Name_Implementation_Suffix, File_Name_Type (Suffix.Value);
In_Package => Naming_Id, end if;
In_Tree => In_Tree);
end if;
if Suffix /= Nil_Variable_Value then
In_Tree.Languages_Data.Table (Lang_Id).
Config.Naming_Data.Body_Suffix :=
File_Name_Type (Suffix.Value);
end if;
-- ??? As opposed to what is done in Check_Naming_Ada_Only, -- ??? As opposed to what is done in Check_Naming_Ada_Only,
-- we do not check whether spec_suffix=body_suffix, which -- we do not check whether spec_suffix=body_suffix, which
-- should be illegal. Best would be to share this code into -- should be illegal. Best would be to share this code into
-- Check_Common, but we access the attributes from the project -- Check_Common, but we access the attributes from the project
-- files slightly differently apparently. -- files slightly differently apparently.
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