+2011-08-03 Robert Dewar <dewar@adacore.com>
+
+ * prj-proc.adb, exp_util.ads, exp_ch9.adb, make.adb, prj-ext.adb,
+ prj-ext.ads, alfa.ads, sem_ch4.adb, makeutl.adb, makeutl.ads,
+ lib-xref-alfa.adb, sem_cat.adb, exp_dist.adb, get_alfa.adb,
+ prj-env.adb, prj-env.ads, prj-tree.adb, alfa.ads: Minor reformatting.
+
2011-08-03 Javier Miranda <miranda@adacore.com>
* exp_util.adb, sem_aux.adb, exp_util.ads, sem_aux.ads:
-- FS . scope line type col entity (-> spec-file . spec-scope)?
+ -- What is the ? marke here, is it part of the actual syntax, or is
+ -- it a query about a problem, in which case it should be ???
+
-- scope is the ones-origin scope number for the current file (e.g. 2 =
-- reference to the second FS line in this FD block).
Prefix =>
New_Reference_To (Defining_Identifier (N_Node), Loc)));
- -- If it is a vm_by_copy_actual, copy it to a new variable
+ -- If it is a VM_By_Copy_Actual, copy it to a new variable
elsif Is_VM_By_Copy_Actual (Actual) then
N_Node :=
pragma Warnings (Off, Subp_Str);
begin
+ -- Disable expansion of stubs if serious errors have been diagnosed,
+ -- because otherwise some illegal remote subprogram declarations
+ -- could cause cascaded errors in stubs.
+
if Serious_Errors_Detected /= 0 then
return;
end if;
pragma Warnings (Off, Subp_Val);
begin
+ -- Disable expansion of stubs if serious errors have been
+ -- diagnosed, because otherwise some illegal remote subprogram
+ -- declarations could cause cascaded errors in stubs.
+
if Serious_Errors_Detected /= 0 then
return;
end if;
Proxy_Obj_Addr : Entity_Id;
begin
+ -- Disable expansion of stubs if serious errors have been
+ -- diagnosed, because otherwise some illegal remote subprogram
+ -- declarations could cause cascaded errors in stubs.
+
if Serious_Errors_Detected /= 0 then
return;
end if;
function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean;
-- Returns True if we are compiling on VM targets and N is a node that
- -- requires to be passed by copy in these targets.
+ -- requires pass-by-copy in these targets.
procedure Kill_Dead_Code (N : Node_Id; Warn : Boolean := False);
-- N represents a node for a section of code that is known to be dead. Any
Spec_File := Get_Nat;
Check ('.');
Spec_Scope := Get_Nat;
+
else
Spec_File := 0;
Spec_Scope := 0;
for S in From .. ALFA_Scope_Table.Last loop
declare
E : Entity_Id renames ALFA_Scope_Table.Table (S).Scope_Entity;
+
begin
if Lib.Get_Source_Unit (E) = U then
ALFA_Scope_Table.Table (S).Scope_Num := Count;
for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop
declare
Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
+
Body_Entity : Entity_Id;
Spec_Entity : Entity_Id;
Spec_Scope : Scope_Index;
+
begin
if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then
Body_Entity := Parent (Parent (Srec.Scope_Entity));
end if;
end;
end loop;
-
end;
-- Generate cross reference ALFA information
function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is
begin
- return Entity_Hashed_Range
- (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
+ return
+ Entity_Hashed_Range (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
end Entity_Hash;
-----------------------------------------
Switches :=
Switches_Of
- (Source_File => Source_File,
- Project => Arguments_Project,
- In_Package => Compiler_Package,
- Allow_ALI => False);
+ (Source_File => Source_File,
+ Project => Arguments_Project,
+ In_Package => Compiler_Package,
+ Allow_ALI => False);
end if;
------------------
procedure Get_Switches
- (Source_File : File_Name_Type;
- Source_Lang : Name_Id;
- Source_Prj : Project_Id;
- Pkg_Name : Name_Id;
- Project_Tree : Project_Tree_Ref;
- Value : out Variable_Value;
- Is_Default : out Boolean;
+ (Source_File : File_Name_Type;
+ Source_Lang : Name_Id;
+ Source_Prj : Project_Id;
+ Pkg_Name : Name_Id;
+ Project_Tree : Project_Tree_Ref;
+ Value : out Variable_Value;
+ Is_Default : out Boolean;
Test_Without_Suffix : Boolean := False;
Check_ALI_Suffix : Boolean := False)
is
In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Lang : Language_Ptr;
+
begin
Is_Default := False;
Spec_Suffix : String := Get_Name_String (Naming.Spec_Suffix);
Body_Suffix : String := Get_Name_String (Naming.Body_Suffix);
Truncated : Boolean := False;
+
begin
Canonical_Case_File_Name (Spec_Suffix);
Canonical_Case_File_Name (Body_Suffix);
Value : out Variable_Value;
Is_Default : out Boolean);
procedure Get_Switches
- (Source_File : File_Name_Type;
- Source_Lang : Name_Id;
- Source_Prj : Project_Id;
- Pkg_Name : Name_Id;
- Project_Tree : Project_Tree_Ref;
- Value : out Variable_Value;
- Is_Default : out Boolean;
+ (Source_File : File_Name_Type;
+ Source_Lang : Name_Id;
+ Source_Prj : Project_Id;
+ Pkg_Name : Name_Id;
+ Project_Tree : Project_Tree_Ref;
+ Value : out Variable_Value;
+ Is_Default : out Boolean;
Test_Without_Suffix : Boolean := False;
Check_ALI_Suffix : Boolean := False);
-- Compute the switches (Compilation switches for instance) for the given
-- file. This checks various attributes to see if there are file specific
-- switches, or else defaults on the switches for the corresponding
-- language. Is_Default is set to False if there were file-specific
- -- switches Source_File can be set to No_File to force retrieval of
- -- the default switches.
- -- If Test_Without_Suffix is True, and there is no
- -- " for Switches(Source_File) use", then this procedure also tests without
- -- the extension of the filename.
- -- If Test_Without_Suffix is True and Check_ALI_Suffix is True, then we
- -- also replace the file extension with ".ali" when testing.
+ -- switches Source_File can be set to No_File to force retrieval of the
+ -- default switches. If Test_Without_Suffix is True, and there is no " for
+ -- Switches(Source_File) use", then this procedure also tests without the
+ -- extension of the filename. If Test_Without_Suffix is True and
+ -- Check_ALI_Suffix is True, then we also replace the file extension with
+ -- ".ali" when testing.
function Linker_Options_Switches
(Project : Project_Id;
-- of project Project, in project tree In_Tree, and in the projects that
-- it imports directly or indirectly, and returns the result.
- -- Package Mains is used to store the mains specified on the command line
- -- and to retrieve them when a project file is used, to verify that the
- -- files exist and that they belong to a project file.
-
function Unit_Index_Of (ALI_File : File_Name_Type) return Int;
-- Find the index of a unit in a source file. Return zero if the file is
-- not a multi-unit source file.
-- Mains --
-----------
+ -- Package Mains is used to store the mains specified on the command line
+ -- and to retrieve them when a project file is used, to verify that the
+ -- files exist and that they belong to a project file.
+
-- Mains are stored in a table. An index is used to retrieve the mains
-- from the table.
procedure Copy (From : Project_Search_Path; To : out Project_Search_Path) is
begin
Free (To);
+
if From.Path /= null then
To.Path := new String'(From.Path.all);
end if;
- -- No need to copy the Cache, it will be recomputed as needed.
+ -- No need to copy the Cache, it will be recomputed as needed
+
end Copy;
end Prj.Env;
end record;
No_Project_Search_Path : constant Project_Search_Path :=
- (Path => null,
- Cache => Projects_Paths.Nil);
+ (Path => null,
+ Cache => Projects_Paths.Nil);
end Prj.Env;
N := Name_To_Name_HTable.Get_First (Copy_From.Refs.all);
while N /= null loop
N2 := new Name_To_Name'
- (Key => N.Key,
- Value => N.Value,
- Source => N.Source,
- Next => null);
+ (Key => N.Key,
+ Value => N.Value,
+ Source => N.Source,
+ Next => null);
Name_To_Name_HTable.Set (Self.Refs.all, N2);
N := Name_To_Name_HTable.Get_Next (Copy_From.Refs.all);
end loop;
if Source /= External_Source'First then
N := Name_To_Name_HTable.Get (Self.Refs.all, Key);
+
if N /= null then
if External_Source'Pos (N.Source) <
- External_Source'Pos (Source)
+ External_Source'Pos (Source)
then
if Current_Verbosity = High then
Debug_Output
Name_Len := Value'Length;
Name_Buffer (1 .. Name_Len) := Value;
N := new Name_To_Name'
- (Key => Key,
- Source => Source,
- Value => Name_Find,
- Next => null);
+ (Key => Key,
+ Source => Source,
+ Value => Name_Find,
+ Next => null);
if Current_Verbosity = High then
Debug_Output ("Add external (" & External_Name & ") is", N.Value);
(From_Command_Line,
From_Environment,
From_External_Attribute);
- -- Where was the value of an external reference defined ?
- -- They are prioritized in that order, so that a user can always use the
- -- command line to override a value coming from his environment, or an
- -- environment variable to override a value defined in an aggregate project
- -- through the "for External()..." attribute.
+ -- Indicates where was the value of an external reference defined. They are
+ -- prioritized in that order, so that a user can always use the command
+ -- line to override a value coming from his environment, or an environment
+ -- variable to override a value defined in an aggregate project through the
+ -- "for External()..." attribute.
procedure Add
(Self : External_References;
External_Name : String;
Value : String;
Source : External_Source := External_Source'First);
- -- Add an external reference (or modify an existing one).
- -- No overriding is done if the Source's priority is less than the one
- -- used to previously set the value of the variable. The default for Source
- -- is such that overriding always occurs.
+ -- Add an external reference (or modify an existing one). No overriding is
+ -- done if the Source's priority is less than the one used to previously
+ -- set the value of the variable. The default for Source is such that
+ -- overriding always occurs.
function Value_Of
(Self : External_References;
-- and free any allocated memory.
private
-
-- Use a Static_HTable, rather than a Simple_HTable
-- The issue is that we need to be able to copy the contents of the table
-- Find the package of Project whose name is With_Name
procedure Process_Declarative_Items
- (Project : Project_Id;
- In_Tree : Project_Tree_Ref;
- From_Project_Node : Project_Node_Id;
- Node_Tree : Project_Node_Tree_Ref;
- Env : Prj.Tree.Environment;
- Pkg : Package_Id;
- Item : Project_Node_Id;
- Child_Env : in out Prj.Tree.Environment;
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref;
+ From_Project_Node : Project_Node_Id;
+ Node_Tree : Project_Node_Tree_Ref;
+ Env : Prj.Tree.Environment;
+ Pkg : Package_Id;
+ Item : Project_Node_Id;
+ Child_Env : in out Prj.Tree.Environment;
Can_Modify_Child_Env : Boolean);
-- Process declarative items starting with From_Project_Node, and put them
-- in declarations Decl. This is a recursive procedure; it calls itself for
-- a package declaration or a case construction.
+ --
-- Child_Env is the modified environment after seeing declarations like
-- "for External(...) use" or "for Project_Path use" in aggregate projects.
-- It should have been initialized first. This environment can only be
-- as processed, call itself recursively for all imported projects and a
-- extended project, if any. Then process the declarative items of the
-- project.
+ --
-- Child_Env is the environment created from an aggregate project (new
-- external values or project path), and should be initialized before the
-- call.
+ --
-- Is_Root_Project should be true only for the project that the user
-- explicitly loaded. In the context of aggregate projects, only that
-- project is allowed to modify the environment that will be used to load
if Present (Decl_Item) then
Process_Declarative_Items
- (Project => Project,
- In_Tree => In_Tree,
- From_Project_Node => From_Project_Node,
- Node_Tree => Node_Tree,
- Env => Env,
- Pkg => Pkg,
- Item => Decl_Item,
- Child_Env => Child_Env,
- Can_Modify_Child_Env => Can_Modify_Child_Env);
+ (Project => Project,
+ In_Tree => In_Tree,
+ From_Project_Node => From_Project_Node,
+ Node_Tree => Node_Tree,
+ Env => Env,
+ Pkg => Pkg,
+ Item => Decl_Item,
+ Child_Env => Child_Env,
+ Can_Modify_Child_Env => Can_Modify_Child_Env);
end if;
end Process_Case_Construction;
Reset_Tree : Boolean := True)
is
Child_Env : Prj.Tree.Environment;
+
begin
if Reset_Tree then
begin
pragma Assert
(Present (Node)
- and then
- In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
+ and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
In_Tree.Project_Nodes.Table (Node).Flag1 := True;
end Set_Is_Not_Last_In_List;
Component : Entity_Id;
Comp_Type : Entity_Id;
U_Typ : constant Entity_Id := Underlying_Type (Typ);
+
begin
if No (U_Typ) then
return False;
function No_External_Streaming (E : Entity_Id) return Boolean is
U_E : constant Entity_Id := Underlying_Type (E);
+
begin
if No (U_E) then
return False;
elsif Has_Read_Write_Attributes (E) then
+
-- Note: availability of stream attributes is tested on E, not U_E.
-- There may be stream attributes defined on U_E that are not visible
-- at the place where support of external streaming is tested.
or else
(Ekind (Typ) = E_Anonymous_Access_Type
- and then
- Base_Type (Designated_Type (Typ)) = Base_Type (Corr_Type));
+ and then
+ Base_Type (Designated_Type (Typ)) = Base_Type (Corr_Type));
end Valid_First_Argument_Of;
-- Start of processing for Try_Primitive_Operation
projects / gcc.git / commitdiff