+2010-10-05 Robert Dewar <dewar@adacore.com>
+
+ * prj-util.adb, prj-util.ads, prj.ads, s-vxwext-rtp.adb, sem_ch4.adb,
+ sem_ch7.adb, sem_res.adb, sem_type.adb: Minor reformatting.
+ Minor code reorganization (use Nkind_In).
+
2010-10-05 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Analyze_Task_Body_Stub): Diagnose duplicate stub for
----------------
procedure Initialize
- (Iter : out Source_Info_Iterator; For_Project : Name_Id)
+ (Iter : out Source_Info_Iterator;
+ For_Project : Name_Id)
is
Ind : constant Natural := Source_Info_Project_HTable.Get (For_Project);
begin
if Ind = 0 then
Iter := (No_Source_Info, 0);
-
else
Iter := Source_Info_Table.Table (Ind);
end if;
----------------------------
procedure Write_Source_Info_File (Tree : Project_Tree_Ref) is
- Iter : Source_Iterator := For_Each_Source (Tree);
+ Iter : Source_Iterator := For_Each_Source (Tree);
Source : Prj.Source_Id;
File : Text_File;
+
begin
if Opt.Verbose_Mode then
Write_Line ("Writing new source info file " &
if not Source.Locally_Removed and then
Source.Replaced_By = No_Source
then
- -- project name
+ -- Project name
+
Put_Line (File, Get_Name_String (Source.Project.Name));
- -- language name
+
+ -- Language name
+
Put_Line (File, Get_Name_String (Source.Language.Name));
- -- kind
+
+ -- Kind
+
Put_Line (File, Source.Kind'Img);
- -- display path name
+
+ -- Display path name
+
Put_Line (File, Get_Name_String (Source.Path.Display_Name));
-- Optional lines:
- -- path name (P=)
+ -- Path name (P=)
+
if Source.Path.Name /= Source.Path.Display_Name then
Put (File, "P=");
Put_Line (File, Get_Name_String (Source.Path.Name));
end if;
- -- unit name (U=)
+ -- Unit name (U=)
+
if Source.Unit /= No_Unit_Index then
Put (File, "U=");
Put_Line (File, Get_Name_String (Source.Unit.Name));
end if;
- -- multi-source index (I=)
+ -- Multi-source index (I=)
+
if Source.Index /= 0 then
Put (File, "I=");
Put_Line (File, Source.Index'Img);
end if;
- -- naming exception ("N=T");
+ -- Naming exception ("N=T");
+
if Source.Naming_Exception then
Put_Line (File, "N=T");
end if;
- -- empty line to indicate end of info on this source
+ -- Empty line to indicate end of info on this source
+
Put_Line (File, "");
end if;
In_Tree : Project_Tree_Ref;
Force_Lower_Case_Index : Boolean := False;
Allow_Wildcards : Boolean := False) return Variable_Value;
- -- In a specific package,
+ -- In a specific package:
-- - if there exists an array Attribute_Or_Array_Name with an index Name,
-- returns the corresponding component (depending on the attribute, the
-- index may or may not be case sensitive, see previous function),
(Name : Name_Id;
In_Packages : Package_Id;
In_Tree : Project_Tree_Ref) return Package_Id;
- -- Returns a specified package in a package list. Returns No_Package if
- -- In_Packages is null or if Name is not the name of a package in
+ -- Returns a specified package in a package list. Returns No_Package
+ -- if In_Packages is null or if Name is not the name of a package in
-- Package_List. The caller must ensure that Name is in lower case.
function Value_Of
(S : String;
Max_Length : Positive;
Separator : Character);
- -- Output string S using Output.Write_Str. If S is too long to fit in
- -- one line of Max_Length, cut it in several lines, using Separator as
- -- the last character of each line, if possible.
+ -- Output string S using Output.Write_Str. If S is too long to fit in one
+ -- line of Max_Length, cut it in several lines, using Separator as the last
+ -- character of each line, if possible.
type Text_File is limited private;
-- Represents a text file (default is invalid text file)
-- the new file.
procedure Read_Source_Info_File (Tree : Project_Tree_Ref);
- -- Check if there is a source info file specified for the project Tree and
- -- if there is one, attempt to read it. If the file exists and is
- -- successfully read, set the flag Source_Info_File_Exists to True for
- -- the tree.
+ -- Check if there is a source info file specified for the project Tree. If
+ -- so, attempt to read it. If the file exists and is successfully read, set
+ -- the flag Source_Info_File_Exists to True for the tree.
type Source_Info_Data is record
Project : Name_Id;
-- Iterator to get the sources for a single project
procedure Initialize
- (Iter : out Source_Info_Iterator; For_Project : Name_Id);
+ (Iter : out Source_Info_Iterator;
+ For_Project : Name_Id);
-- Initiaize Iter for the project
function Source_Info_Of (Iter : Source_Info_Iterator) return Source_Info;
-- Advance the iterator to the next source in the project
private
-
type Text_File_Data is record
FD : File_Descriptor := Invalid_FD;
Out_File : Boolean := False;
Makefile_Dependency_Suffix : constant String := ".d";
ALI_Dependency_Suffix : constant String := ".ali";
-
Switches_Dependency_Suffix : constant String := ".cswi";
- Binder_Exchange_Suffix : constant String := ".bexch";
+ Binder_Exchange_Suffix : constant String := ".bexch";
-- Suffix for binder exchange files
- Library_Exchange_Suffix : constant String := ".lexch";
+ Library_Exchange_Suffix : constant String := ".lexch";
-- Suffix for library exchange files
type Name_List_Index is new Nat;
- No_Name_List : constant Name_List_Index := 0;
+ No_Name_List : constant Name_List_Index := 0;
type Name_Node is record
Name : Name_Id := No_Name;
Packages : Package_Table.Instance;
Projects : Project_List;
- Units_HT : Units_Htable.Instance;
+ Units_HT : Units_Htable.Instance;
-- Unit name to Unit_Index (and from there so Source_Id)
- Source_Paths_HT : Source_Paths_Htable.Instance;
+ Source_Paths_HT : Source_Paths_Htable.Instance;
-- Full path to Source_Id
- Source_Info_File_Name : String_Access := null;
+ Source_Info_File_Name : String_Access := null;
-- The name of the source info file, if specified by the builder
Source_Info_File_Exists : Boolean := False;
-- True when a source info file has been successfully read
- Private_Part : Private_Project_Tree_Data;
+ Private_Part : Private_Project_Tree_Data;
end record;
-- Data for a project tree
function Interrupt_Connect
(Vector : Interrupt_Vector;
Handler : Interrupt_Handler;
- Parameter : System.Address := System.Null_Address) return int is
+ Parameter : System.Address := System.Null_Address) return int
+ is
pragma Unreferenced (Vector, Handler, Parameter);
begin
return ERROR;
--------------------------------
function Interrupt_Number_To_Vector
- (intNum : int) return Interrupt_Vector is
+ (intNum : int) return Interrupt_Vector
+ is
pragma Unreferenced (intNum);
begin
return 0;
if Is_Discrete_Type (Entity (Actual)) then
Rewrite (N,
Make_Slice (Loc,
- Prefix => Make_Function_Call (Loc,
- Name => Relocate_Node (Name (N))),
- Discrete_Range =>
+ Prefix =>
+ Make_Function_Call (Loc,
+ Name => Relocate_Node (Name (N))),
+ Discrete_Range =>
New_Occurrence_Of (Entity (Actual), Sloc (Actual))));
Analyze (N);
function Has_Referencer
(L : List_Id;
- Outer : Boolean)
- return Boolean;
+ Outer : Boolean) return Boolean;
-- Traverse the given list of declarations in reverse order.
-- Return True if a referencer is present. Return False if none is
-- found. The Outer parameter is True for the outer level call and
function Has_Referencer
(L : List_Id;
- Outer : Boolean)
- return Boolean
+ Outer : Boolean) return Boolean
is
Has_Referencer_Except_For_Subprograms : Boolean := False;
+
D : Node_Id;
E : Entity_Id;
K : Node_Kind;
V : Node_Id;
begin
-
-- Check name of procedure or function calls
if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call)
end if;
return OK;
-
end Check_Subprogram_Ref;
function Check_Subprogram_Refs is
new Traverse_Func (Check_Subprogram_Ref);
+ -- Start of processing for Has_Referencer
+
begin
if No (L) then
return False;
It : Interp;
begin
- -- if the context is an attribute reference that can apply to
- -- functions, this is never a parameterless call. (RM 4.1.4 (6))
+ -- If the context is an attribute reference that can apply to
+ -- functions, this is never a parameterless call (RM 4.1.4 (6)).
if Nkind (Parent (N)) = N_Attribute_Reference
and then (Attribute_Name (Parent (N)) = Name_Address
then
Add_Entry (Entity (N), Etype (N));
- elsif (Nkind (N) = N_Function_Call
- or else Nkind (N) = N_Procedure_Call_Statement)
+ elsif Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
and then Is_Entity_Name (Name (N))
then
Add_Entry (Entity (Name (N)), Etype (N));