Commit 442c0581 by Robert Dewar Committed by Arnaud Charlet

prj.adb, [...]: Minor reformatting & comment edits.

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* prj.adb, sem_ch4.adb, sem_res.adb, prj-nmsc.adb: Minor reformatting
	& comment edits.

From-SVN: r149571
parent 3c2815d8
2009-07-13 Robert Dewar <dewar@adacore.com> 2009-07-13 Robert Dewar <dewar@adacore.com>
* prj.adb, sem_ch4.adb, sem_res.adb, prj-nmsc.adb: Minor reformatting
& comment edits.
2009-07-13 Robert Dewar <dewar@adacore.com>
* opt.ads, prj-conf.adb, prj-env.adb, prj-ext.adb, prj-nmsc.adb, * opt.ads, prj-conf.adb, prj-env.adb, prj-ext.adb, prj-nmsc.adb,
prj-proc.adb, prj-tree.adb, prj-tree.ads: Minor reformatting prj-proc.adb, prj-tree.adb, prj-tree.ads: Minor reformatting
......
...@@ -288,8 +288,8 @@ package body Prj.Nmsc is ...@@ -288,8 +288,8 @@ package body Prj.Nmsc is
-- Output an error message. If Data.Error_Report is null, simply call -- Output an error message. If Data.Error_Report is null, simply call
-- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
-- Error_Report. If Msg starts with "?", this is a warning, and the -- Error_Report. If Msg starts with "?", this is a warning, and the
-- string "Warning :" is adding at the beginning. If Msg starts with "<", -- string "Warning:" is prepended to the message. If Msg starts with "<",
-- see comment for Err_Vars.Error_Msg_Warn -- see comment for Err_Vars.Error_Msg_Warn.
procedure Search_Directories procedure Search_Directories
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
...@@ -297,10 +297,10 @@ package body Prj.Nmsc is ...@@ -297,10 +297,10 @@ package body Prj.Nmsc is
For_All_Sources : Boolean); For_All_Sources : Boolean);
-- Search the source directories to find the sources. If For_All_Sources is -- Search the source directories to find the sources. If For_All_Sources is
-- True, check each regular file name against the naming schemes of the -- True, check each regular file name against the naming schemes of the
-- different languages. Otherwise consider only the file names in the hash -- various languages. Otherwise consider only the file names in hash table
-- table Source_Names. If Allow_Duplicate_Basenames, then files with the -- Source_Names. If Allow_Duplicate_Basenames then files with identical
-- same base names are authorized within a project for source-based -- base names are permitted within a project for source-based languages
-- languages (never for unit based languages) -- (never for unit based languages).
procedure Check_File procedure Check_File
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
...@@ -321,13 +321,12 @@ package body Prj.Nmsc is ...@@ -321,13 +321,12 @@ package body Prj.Nmsc is
-- File_Name is the same as Name, but has been normalized. -- File_Name is the same as Name, but has been normalized.
-- Display_File_Name, however, has not been normalized. -- Display_File_Name, however, has not been normalized.
-- --
-- Source_Directory is the directory in which the file -- Source_Directory is the directory in which the file was found. It is
-- was found. It hasn't been normalized (nor has had links resolved). -- neither normalized nor has had links resolved, and must not end with a
-- It should not end with a directory separator, to avoid duplicates -- a directory separator, to avoid duplicates later on.
-- later on.
-- --
-- If For_All_Sources is True, then all possible file names are analyzed -- If For_All_Sources is True, then all possible file names are analyzed
-- otherwise only those currently set in the Source_Names htable. -- otherwise only those currently set in the Source_Names hash table.
procedure Check_File_Naming_Schemes procedure Check_File_Naming_Schemes
(In_Tree : Project_Tree_Ref; (In_Tree : Project_Tree_Ref;
......
...@@ -52,13 +52,15 @@ package body Prj is ...@@ -52,13 +52,15 @@ package body Prj is
subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case; subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
type Cst_String_Access is access constant String; type Cst_String_Access is access constant String;
All_Lower_Case_Image : aliased constant String := "lowercase"; All_Lower_Case_Image : aliased constant String := "lowercase";
All_Upper_Case_Image : aliased constant String := "UPPERCASE"; All_Upper_Case_Image : aliased constant String := "UPPERCASE";
Mixed_Case_Image : aliased constant String := "MixedCase"; Mixed_Case_Image : aliased constant String := "MixedCase";
The_Casing_Images : constant array (Known_Casing) of Cst_String_Access := The_Casing_Images : constant array (Known_Casing) of Cst_String_Access :=
(All_Lower_Case => All_Lower_Case_Image'Access, (All_Lower_Case => All_Lower_Case_Image'Access,
All_Upper_Case => All_Upper_Case_Image'Access, All_Upper_Case => All_Upper_Case_Image'Access,
Mixed_Case => Mixed_Case_Image'Access); Mixed_Case => Mixed_Case_Image'Access);
Project_Empty : constant Project_Data := Project_Empty : constant Project_Data :=
(Qualifier => Unspecified, (Qualifier => Unspecified,
...@@ -171,6 +173,7 @@ package body Prj is ...@@ -171,6 +173,7 @@ package body Prj is
is is
Dont_Care : Boolean; Dont_Care : Boolean;
pragma Warnings (Off, Dont_Care); pragma Warnings (Off, Dont_Care);
begin begin
if not Debug.Debug_Flag_N then if not Debug.Debug_Flag_N then
if Current_Verbosity = High then if Current_Verbosity = High then
...@@ -196,7 +199,9 @@ package body Prj is ...@@ -196,7 +199,9 @@ package body Prj is
procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref) is procedure Delete_All_Temp_Files (Tree : Project_Tree_Ref) is
Dont_Care : Boolean; Dont_Care : Boolean;
pragma Warnings (Off, Dont_Care); pragma Warnings (Off, Dont_Care);
Path : Path_Name_Type; Path : Path_Name_Type;
begin begin
if not Debug.Debug_Flag_N then if not Debug.Debug_Flag_N then
for Index in for Index in
...@@ -681,7 +686,8 @@ package body Prj is ...@@ -681,7 +686,8 @@ package body Prj is
procedure Record_Temp_File procedure Record_Temp_File
(Tree : Project_Tree_Ref; (Tree : Project_Tree_Ref;
Path : Path_Name_Type) is Path : Path_Name_Type)
is
begin begin
Temp_Files_Table.Append (Tree.Private_Part.Temp_Files, Path); Temp_Files_Table.Append (Tree.Private_Part.Temp_Files, Path);
end Record_Temp_File; end Record_Temp_File;
......
...@@ -2047,7 +2047,6 @@ package body Sem_Ch4 is ...@@ -2047,7 +2047,6 @@ package body Sem_Ch4 is
Set_Etype (L, T_F); Set_Etype (L, T_F);
end if; end if;
end Try_One_Interp; end Try_One_Interp;
procedure Analyze_Set_Membership; procedure Analyze_Set_Membership;
...@@ -2062,7 +2061,6 @@ package body Sem_Ch4 is ...@@ -2062,7 +2061,6 @@ package body Sem_Ch4 is
Alt : Node_Id; Alt : Node_Id;
Index : Interp_Index; Index : Interp_Index;
It : Interp; It : Interp;
Candidate_Interps : Node_Id; Candidate_Interps : Node_Id;
Common_Type : Entity_Id := Empty; Common_Type : Entity_Id := Empty;
...@@ -2094,22 +2092,24 @@ package body Sem_Ch4 is ...@@ -2094,22 +2092,24 @@ package body Sem_Ch4 is
else else
Get_First_Interp (Alt, Index, It); Get_First_Interp (Alt, Index, It);
while Present (It.Typ) loop while Present (It.Typ) loop
if if not
not Has_Compatible_Type (Candidate_Interps, It.Typ) Has_Compatible_Type (Candidate_Interps, It.Typ)
then then
Remove_Interp (Index); Remove_Interp (Index);
end if; end if;
Get_Next_Interp (Index, It); Get_Next_Interp (Index, It);
end loop; end loop;
Get_First_Interp (Alt, Index, It); Get_First_Interp (Alt, Index, It);
if No (It.Typ) then if No (It.Typ) then
Error_Msg_N ("alternative has no legal type", Alt); Error_Msg_N ("alternative has no legal type", Alt);
return; return;
end if; end if;
-- If alternative is not overloaded, we have a -- If alternative is not overloaded, we have a unique type
-- unique type for all of them. -- for all of them.
Set_Etype (Alt, It.Typ); Set_Etype (Alt, It.Typ);
Get_Next_Interp (Index, It); Get_Next_Interp (Index, It);
......
...@@ -6768,7 +6768,7 @@ package body Sem_Res is ...@@ -6768,7 +6768,7 @@ package body Sem_Res is
end loop; end loop;
end Resolve_Set_Membership; end Resolve_Set_Membership;
-- start of processing for Resolve_Membership_Op -- Start of processing for Resolve_Membership_Op
begin begin
if L = Error or else R = Error then if L = Error or else R = Error then
......
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