Commit f1eea135 by Emmanuel Briot Committed by Arnaud Charlet

prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the separate_suffix to…

prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the separate_suffix to the same value as the body_suffix.

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

	* prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the
	separate_suffix to the same value as the body_suffix.

From-SVN: r146574
parent d9c0e057
2009-04-22 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Check_Naming_Ada_Only): Properly initialize the
separate_suffix to the same value as the body_suffix.
2009-04-22 Robert Dewar <dewar@adacore.com> 2009-04-22 Robert Dewar <dewar@adacore.com>
* prj.adb: Minor code reorganization * prj.adb: Minor code reorganization
......
...@@ -3247,10 +3247,10 @@ package body Prj.Nmsc is ...@@ -3247,10 +3247,10 @@ package body Prj.Nmsc is
--------------------------- ---------------------------
procedure Check_Naming_Ada_Only is procedure Check_Naming_Ada_Only is
Casing_Defined : Boolean; Casing_Defined : Boolean;
Spec_Suffix : File_Name_Type; Spec_Suffix : File_Name_Type;
Body_Suffix : File_Name_Type; Body_Suffix : File_Name_Type;
Sep_Suffix_Loc : Source_Ptr; Sep_Suffix_Loc : Source_Ptr;
Ada_Spec_Suffix : constant Variable_Value := Ada_Spec_Suffix : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
...@@ -3267,7 +3267,26 @@ package body Prj.Nmsc is ...@@ -3267,7 +3267,26 @@ package body Prj.Nmsc is
In_Tree => In_Tree); In_Tree => In_Tree);
begin begin
-- We'll need the dot replacement below, so compute it first -- The default value of separate suffix should be the same as the
-- body suffix, so we need to compute that first.
if Ada_Body_Suffix.Kind = Single
and then Length_Of_Name (Ada_Body_Suffix.Value) /= 0
then
Body_Suffix := Canonical_Case_File_Name (Ada_Body_Suffix.Value);
Data.Naming.Separate_Suffix := Body_Suffix;
Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
else
Body_Suffix := Default_Ada_Body_Suffix;
Data.Naming.Separate_Suffix := Body_Suffix;
Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
end if;
Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix));
-- We'll need the dot replacement below, so compute it now.
Check_Common Check_Common
(Dot_Replacement => Data.Naming.Dot_Replacement, (Dot_Replacement => Data.Naming.Dot_Replacement,
Casing => Data.Naming.Casing, Casing => Data.Naming.Casing,
...@@ -3300,7 +3319,7 @@ package body Prj.Nmsc is ...@@ -3300,7 +3319,7 @@ package body Prj.Nmsc is
Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix); Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix);
if Is_Illegal_Suffix if Is_Illegal_Suffix
(Spec_Suffix, Data.Naming.Dot_Replacement) (Spec_Suffix, Data.Naming.Dot_Replacement)
then then
Err_Vars.Error_Msg_File_1 := Spec_Suffix; Err_Vars.Error_Msg_File_1 := Spec_Suffix;
Error_Msg Error_Msg
...@@ -3318,36 +3337,19 @@ package body Prj.Nmsc is ...@@ -3318,36 +3337,19 @@ package body Prj.Nmsc is
-- Check Body_Suffix -- Check Body_Suffix
if Ada_Body_Suffix.Kind = Single if Is_Illegal_Suffix (Body_Suffix, Data.Naming.Dot_Replacement) then
and then Get_Name_String (Ada_Body_Suffix.Value) /= "" Err_Vars.Error_Msg_File_1 := Body_Suffix;
then Error_Msg
Body_Suffix := Canonical_Case_File_Name (Ada_Body_Suffix.Value); (Project, In_Tree,
Data.Naming.Separate_Suffix := Body_Suffix; "{ is illegal for Body_Suffix",
Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix); Ada_Body_Suffix.Location);
if Is_Illegal_Suffix
(Body_Suffix, Data.Naming.Dot_Replacement)
then
Err_Vars.Error_Msg_File_1 := Body_Suffix;
Error_Msg
(Project, In_Tree,
"{ is illegal for Body_Suffix",
Ada_Body_Suffix.Location);
end if;
else
Body_Suffix := Default_Ada_Body_Suffix;
Data.Naming.Separate_Suffix := Body_Suffix;
Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
end if; end if;
Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix));
-- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix, -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
-- since that would cause a clear ambiguity. Note that we do -- since that would cause a clear ambiguity. Note that we do allow a
-- allow a Spec_Suffix to have the same termination as one of -- Spec_Suffix to have the same termination as one of these, which
-- these, which causes a potential ambiguity, but we resolve -- causes a potential ambiguity, but we resolve that my matching the
-- that my matching the longest possible suffix. -- longest possible suffix.
if Spec_Suffix = Body_Suffix then if Spec_Suffix = Body_Suffix then
Error_Msg Error_Msg
...@@ -3376,13 +3378,12 @@ package body Prj.Nmsc is ...@@ -3376,13 +3378,12 @@ package body Prj.Nmsc is
procedure Check_Naming_Multi_Lang is procedure Check_Naming_Multi_Lang is
begin begin
-- We are now checking if attribute Dot_Replacement, Casing, -- We are now checking if attribute Dot_Replacement, Casing, and/or
-- and/or Separate_Suffix exist. -- Separate_Suffix exist.
-- For each attribute, if it does not exist, we do nothing, -- For each attribute, if it does not exist, we do nothing, because
-- because we already have the default. -- we already have the default. Otherwise, for all unit-based
-- Otherwise, for all unit-based languages, we put the declared -- languages, we put the declared value in the language config.
-- value in the language config.
declare declare
Dot_Replacement : File_Name_Type := No_File; Dot_Replacement : File_Name_Type := No_File;
...@@ -3400,8 +3401,8 @@ package body Prj.Nmsc is ...@@ -3400,8 +3401,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 -- For all unit based languages, if any, set the specified value
-- value of Dot_Replacement, Casing and/or Separate_Suffix. Do not -- 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
...@@ -3541,10 +3542,10 @@ package body Prj.Nmsc is ...@@ -3541,10 +3542,10 @@ package body Prj.Nmsc is
------------------------------ ------------------------------
procedure Check_Library_Attributes procedure Check_Library_Attributes
(Project : Project_Id; (Project : Project_Id;
In_Tree : Project_Tree_Ref; In_Tree : Project_Tree_Ref;
Current_Dir : String; Current_Dir : String;
Data : in out Project_Data) Data : in out Project_Data)
is is
Attributes : constant Prj.Variable_Id := Data.Decl.Attributes; Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
...@@ -6812,10 +6813,12 @@ package body Prj.Nmsc is ...@@ -6812,10 +6813,12 @@ package body Prj.Nmsc is
if Kind = Spec then if Kind = Spec then
Masked := Unit_Except.Spec /= No_File Masked := Unit_Except.Spec /= No_File
and then Unit_Except.Spec /= File_Name; and then
Unit_Except.Spec /= File_Name;
else else
Masked := Unit_Except.Impl /= No_File Masked := Unit_Except.Impl /= No_File
and then Unit_Except.Impl /= File_Name; and then
Unit_Except.Impl /= File_Name;
end if; end if;
if Masked then if Masked then
...@@ -6926,6 +6929,7 @@ package body Prj.Nmsc is ...@@ -6926,6 +6929,7 @@ package body Prj.Nmsc is
Dot_Replacement : File_Name_Type) return Boolean Dot_Replacement : File_Name_Type) return Boolean
is is
Suffix_Str : constant String := Get_Name_String (Suffix); Suffix_Str : constant String := Get_Name_String (Suffix);
begin begin
if Suffix_Str'Length = 0 or else Index (Suffix_Str, ".") = 0 then if Suffix_Str'Length = 0 or else Index (Suffix_Str, ".") = 0 then
return True; return True;
...@@ -7686,10 +7690,10 @@ package body Prj.Nmsc is ...@@ -7686,10 +7690,10 @@ package body Prj.Nmsc is
Lang_Kind : out Language_Kind; Lang_Kind : out Language_Kind;
Kind : out Source_Kind) Kind : out Source_Kind)
is is
Filename : constant String := Get_Name_String (File_Name); Filename : constant String := Get_Name_String (File_Name);
Config : Language_Config; Config : Language_Config;
Lang : Name_List_Index := Data.Languages; Lang : Name_List_Index;
Tmp_Lang : Language_Index; Tmp_Lang : Language_Index;
Header_File : Boolean := False; Header_File : Boolean := False;
-- True if we found at least one language for which the file is a header -- True if we found at least one language for which the file is a header
...@@ -7749,6 +7753,8 @@ package body Prj.Nmsc is ...@@ -7749,6 +7753,8 @@ package body Prj.Nmsc is
end if; end if;
end Check_File_Based_Lang; end Check_File_Based_Lang;
-- Start of processing for Check_File_Naming_Schemes
begin begin
Language := No_Language_Index; Language := No_Language_Index;
Alternate_Languages := No_Alternate_Language; Alternate_Languages := No_Alternate_Language;
...@@ -7757,6 +7763,7 @@ package body Prj.Nmsc is ...@@ -7757,6 +7763,7 @@ package body Prj.Nmsc is
Lang_Kind := File_Based; Lang_Kind := File_Based;
Kind := Spec; Kind := Spec;
Lang := Data.Languages;
while Lang /= No_Name_List loop while Lang /= No_Name_List loop
Language_Name := In_Tree.Name_Lists.Table (Lang).Name; Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
Tmp_Lang := Get_Language_Processing_From_Lang (In_Tree, Data, Lang); Tmp_Lang := Get_Language_Processing_From_Lang (In_Tree, Data, Lang);
...@@ -7780,8 +7787,10 @@ package body Prj.Nmsc is ...@@ -7780,8 +7787,10 @@ package body Prj.Nmsc is
exit when Kind = Impl; exit when Kind = Impl;
when Unit_Based => when Unit_Based =>
-- We know it belongs to a least a file_based language, no -- We know it belongs to a least a file_based language, no
-- need to check unit-based ones. -- need to check unit-based ones.
if not Header_File then if not Header_File then
Compute_Unit_Name Compute_Unit_Name
(File_Name => File_Name, (File_Name => File_Name,
......
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