Skip to content

R
riscv-gcc-1
Commit 9fde638d by Robert Dewar Committed by Arnaud Charlet
Options

prj-proc.adb, [...]: Minor reformatting. 

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.

From-SVN: r177260
parent 95eb8b69
Showing with 111 additions and 77 deletions
gcc/ada/ChangeLog
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:
......
gcc/ada/alfa.ads
......@@ -91,6 +91,9 @@ package ALFA is
-- 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).
......
gcc/ada/exp_ch9.adb
......@@ -3797,7 +3797,7 @@ package body Exp_Ch9 is
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 :=
......
gcc/ada/exp_dist.adb
......@@ -1030,6 +1030,10 @@ package body Exp_Dist is
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;
......@@ -3841,6 +3845,10 @@ package body Exp_Dist is
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;
......@@ -6849,6 +6857,10 @@ package body Exp_Dist is
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;
......
gcc/ada/exp_util.ads
......@@ -539,7 +539,7 @@ package Exp_Util is
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
......
gcc/ada/get_alfa.adb
......@@ -290,6 +290,7 @@ begin
Spec_File := Get_Nat;
Check ('.');
Spec_Scope := Get_Nat;
else
Spec_File := 0;
Spec_Scope := 0;
......
gcc/ada/lib-xref-alfa.adb
......@@ -238,6 +238,7 @@ package body ALFA is
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;
......@@ -819,9 +820,11 @@ package body ALFA is
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));
......@@ -850,7 +853,6 @@ package body ALFA is
end if;
end;
end loop;
end;
-- Generate cross reference ALFA information
......@@ -864,8 +866,8 @@ package body ALFA is
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;
-----------------------------------------
......
gcc/ada/make.adb
......@@ -2311,10 +2311,10 @@ package body Make is
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;
......
gcc/ada/makeutl.adb
......@@ -679,13 +679,13 @@ package body Makeutl is
------------------
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
......@@ -697,6 +697,7 @@ package body Makeutl is
In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Lang : Language_Ptr;
begin
Is_Default := False;
......@@ -724,6 +725,7 @@ package body Makeutl is
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);
......
gcc/ada/makeutl.ads
......@@ -155,26 +155,25 @@ package Makeutl is
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;
......@@ -183,10 +182,6 @@ package Makeutl is
-- 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.
......@@ -211,6 +206,10 @@ package Makeutl is
-- 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.
......
gcc/ada/prj-env.adb
......@@ -2204,11 +2204,13 @@ package body Prj.Env is
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;
gcc/ada/prj-env.ads
......@@ -241,7 +241,7 @@ private
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;
gcc/ada/prj-ext.adb
......@@ -47,10 +47,10 @@ package body Prj.Ext is
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;
......@@ -82,9 +82,10 @@ package body Prj.Ext is
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
......@@ -99,10 +100,10 @@ package body Prj.Ext is
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);
......
gcc/ada/prj-ext.ads
......@@ -58,21 +58,21 @@ package Prj.Ext is
(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;
......@@ -92,7 +92,6 @@ package Prj.Ext is
-- 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
......
gcc/ada/prj-proc.adb
......@@ -125,18 +125,19 @@ package body Prj.Proc is
-- 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
......@@ -158,9 +159,11 @@ package body Prj.Proc is
-- 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
......@@ -2267,15 +2270,15 @@ package body Prj.Proc is
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;
......@@ -2331,6 +2334,7 @@ package body Prj.Proc is
Reset_Tree : Boolean := True)
is
Child_Env : Prj.Tree.Environment;
begin
if Reset_Tree then
......
gcc/ada/prj-tree.adb
......@@ -2270,8 +2270,7 @@ package body Prj.Tree is
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;
......
gcc/ada/sem_cat.adb
......@@ -365,6 +365,7 @@ package body Sem_Cat is
Component : Entity_Id;
Comp_Type : Entity_Id;
U_Typ : constant Entity_Id := Underlying_Type (Typ);
begin
if No (U_Typ) then
return False;
......@@ -628,11 +629,13 @@ package body Sem_Cat is
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.
......
gcc/ada/sem_ch4.adb
......@@ -7263,8 +7263,8 @@ package body Sem_Ch4 is
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
......
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