OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch3.adb, [...]: Minor reformatting

Browse Source 
2011-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, prj-part.adb, par-ch4.adb,
	sem_util.adb, sem_ch4.adb, sem_ch6.adb, sem_ch6.ads, sem_ch8.adb,
	sem_ch8.ads, sem_ch13.ads, par-ch5.adb, prj-env.ads: Minor reformatting

From-SVN: r177055
This commit is contained in:
Robert Dewar 2011-08-01 15:59:50 +00:00 committed by Arnaud Charlet
parent 1982d5a854
commit 8d606a78a3
15 changed files with 116 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/ada/ChangeLog
View File

@ -1,3 +1,9 @@
2011-08-01 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch3.ads, sem_ch5.adb, prj-part.adb, par-ch4.adb,
sem_util.adb, sem_ch4.adb, sem_ch6.adb, sem_ch6.ads, sem_ch8.adb,
sem_ch8.ads, sem_ch13.ads, par-ch5.adb, prj-env.ads: Minor reformatting
2011-08-01 Pascal Obry <obry@adacore.com>
* prj-part.ads, prj-part.adb (Parse): Add Target_Name parameter. Pass

1
gcc/ada/par-ch4.adb
View File

@ -673,6 +673,7 @@ package body Ch4 is
Formal_Error_Msg_SP ("no mixing of positional and named "
& "parameter association");
end if;
Restore_Scan_State (Scan_State); -- to Id
goto LP_State_Call;

5
gcc/ada/par-ch5.adb
View File

@ -2138,8 +2138,9 @@ package body Ch5 is
Inner : while Present (Decl) loop
if (Nkind (Decl) not in N_Later_Decl_Item
or else (SPARK_Mode
and then Nkind (Decl) = N_Package_Declaration))
or else (SPARK_Mode
and then
Nkind (Decl) = N_Package_Declaration))
and then Nkind (Decl) /= N_Pragma
then
if Ada_Version = Ada_83 then

43
gcc/ada/prj-env.ads
View File

@ -35,7 +35,7 @@ package Prj.Env is
-- Initialize global components relative to environment variables
procedure Print_Sources (In_Tree : Project_Tree_Ref);
-- Output the list of sources, after Project files have been scanned
-- Output the list of sources after Project files have been scanned
procedure Create_Mapping (In_Tree : Project_Tree_Ref);
-- Create in memory mapping from the sources of all the projects (in body
@ -47,7 +47,7 @@ package Prj.Env is
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type;
File_Use : String);
-- Create temporary file, and fail with an error if it could not be created
-- Create temporary file, fail with an error if it could not be created
procedure Create_Mapping_File
(Project : Project_Id;
@ -55,27 +55,26 @@ package Prj.Env is
In_Tree : Project_Tree_Ref;
Name : out Path_Name_Type);
-- Create a temporary mapping file for project Project. For each source or
-- template of Language in the Project, put the mapping of its file
-- name and path name in this file.
-- template of Language in the Project, put the mapping of its file name
-- and path name in this file. See fmap for a description of the format
-- of the mapping file.
--
-- Implementation note: we pass a language name, not a language_index here,
-- since the latter would have to match exactly the index of that language
-- for the specified project, and that is not information available in
-- buildgpr.adb.
--
-- See fmap for a description of the format of the mapping file
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- If there needs to have SFN pragmas, either for non standard naming
-- schemes or for individual units.
-- If we need SFN pragmas, either for non standard naming schemes or for
-- individual units.
procedure Create_New_Path_File
(In_Tree : Project_Tree_Ref;
Path_FD : out File_Descriptor;
Path_Name : out Path_Name_Type);
-- Create a new temporary path file. Get the file name in Path_Name
-- Create a new temporary path file, placing file name in Path_Name
function Ada_Include_Path
(Project : Project_Id;
@ -115,7 +114,6 @@ package Prj.Env is
-- name of the spec is returned.
--
-- If Full_Path is False (the default), the simple file name is returned.
--
-- If Full_Path is True, the absolute path name is returned.
--
-- If neither a body nor a spec can be found, an empty string is returned.
@ -152,16 +150,16 @@ package Prj.Env is
generic
with procedure Action (Path : String);
procedure For_All_Object_Dirs (Project : Project_Id);
-- Iterate through all the object directories of a project, including
-- those of imported or modified projects.
-- Iterate through all the object directories of a project, including those
-- of imported or modified projects.
------------------
-- Project Path --
------------------
type Project_Search_Path is private;
-- An abstraction of the project path. This object provides subprograms to
-- search for projects on the path (and caches the results for more
-- An abstraction of the project path. This object provides subprograms
-- to search for projects on the path (and caches the results to improve
-- efficiency).
procedure Free (Self : in out Project_Search_Path);
@ -176,8 +174,7 @@ package Prj.Env is
-- will remove the default project directory from the project path.
--
-- Calls to this subprogram must be performed before the first call to
-- Find_Project below, or PATH will be added at the end of the search
-- path.
-- Find_Project below, or PATH will be added at the end of the search path.
procedure Get_Path
(Self : in out Project_Search_Path;
@ -185,13 +182,13 @@ package Prj.Env is
Target_Name : String := "");
-- Return the current value of the project path, either the value set
-- during elaboration of the package or, if procedure Set_Project_Path has
-- been called, the value set by the last call to Set_Project_Path.
-- The returned value must not be modified.
-- been called, the value set by the last call to Set_Project_Path. The
-- returned value must not be modified.
procedure Set_Path
(Self : in out Project_Search_Path; Path : String);
-- Override the value of the project path.
-- This also removes the implicit default search directories
-- Override the value of the project path. This also removes the implicit
-- default search directories
procedure Find_Project
(Self : in out Project_Search_Path;
@ -220,9 +217,9 @@ private
type Project_Search_Path is record
Path : GNAT.OS_Lib.String_Access;
-- As a special case, if the first character is '#:" or this variable is
-- unset, this means that the PATH has not been fully initialized yet
-- (although subprograms above will properly take care of that).
-- As a special case, if the first character is '#:" or this variable
-- is unset, this means that the PATH has not been fully initialized
-- yet (although subprograms above will properly take care of that).
Cache : Projects_Paths.Instance;
end record;

9
gcc/ada/prj-part.adb
View File

@ -1552,7 +1552,9 @@ package body Prj.Part is
declare
Original_Path_Name : constant String :=
Get_Name_String (Token_Name);
Extended_Project_Path_Name_Id : Path_Name_Type;
begin
Find_Project
(In_Tree.Project_Path,
@ -1569,8 +1571,7 @@ package body Prj.Part is
Error_Msg (Flags, "unknown project file: %%", Token_Ptr);
-- If we are not in the main project file, display the
-- import path.
-- If not in the main project file, display the import path
if Project_Stack.Last > 1 then
Error_Msg_Name_1 :=
@ -1621,8 +1622,8 @@ package body Prj.Part is
end if;
-- An abstract project can only extend an abstract
-- project, otherwise we may have an abstract project
-- with sources, if it inherits sources from the project
-- project. Otherwise we may have an abstract project
-- with sources if it inherits sources from the project
-- it extends.
if Project_Qualifier_Of (Project, In_Tree) = Dry and then

6
gcc/ada/sem_ch13.ads
View File

@ -41,9 +41,9 @@ package Sem_Ch13 is
E : Entity_Id;
L : List_Id);
-- This procedure is called to analyze aspect specifications for node N.
-- E is the corresponding entity declared by the declaration node N, and L
-- is the list of aspect specifications for this node. If L is No_List, the
-- call is ignored. Note that we can't use a simpler interface of just
-- E is the corresponding entity declared by the declaration node N, and
-- L is the list of aspect specifications for this node. If L is No_List,
-- the call is ignored. Note that we can't use a simpler interface of just
-- passing the node N, since the analysis of the node may cause it to be
-- rewritten to a node not permitting aspect specifications.

2
gcc/ada/sem_ch3.adb
View File

@ -2028,7 +2028,7 @@ package body Sem_Ch3 is
while Present (D) loop
-- Package specification cannot contain a package declaration in
-- SPARK or ALFA
-- SPARK or ALFA.
if Formal_Verification_Mode
and then Nkind (D) = N_Package_Declaration

8
gcc/ada/sem_ch3.ads
View File

@ -171,10 +171,10 @@ package Sem_Ch3 is
-- Constraint, return the value of that discriminant.
function Is_Constant_Bound (Exp : Node_Id) return Boolean;
-- Determines whether the given bound is a compile-time known value, or a
-- constant entity, or an enumeration literal, or an expression composed
-- of constant-bound subexpressions which are evaluated by means of
-- standard operators.
-- Exp is the expression for an array bound. Determines whether the
-- bound is a compile-time known value, or a constant entity, or an
-- enumeration literal, or an expression composed of constant-bound
-- subexpressions which are evaluated by means of standard operators.
function Is_Null_Extension (T : Entity_Id) return Boolean;
-- Returns True if the tagged type T has an N_Full_Type_Declaration that

20
gcc/ada/sem_ch4.adb
View File

@ -1494,17 +1494,23 @@ package body Sem_Ch4 is
begin
Set_Etype (N, Any_Type);
Get_First_Interp (Then_Expr, I, It);
if No (Else_Expr) then
-- if no else_expression the conditional must be boolean.
-- Shouldn't the following statement be down in the ELSE of the
-- following loop? ???
Get_First_Interp (Then_Expr, I, It);
-- if no Else_Expression the conditional must be boolean
if No (Else_Expr) then
Set_Etype (N, Standard_Boolean);
-- Else_Expression Present. For each possible intepretation of
-- the Then_Expression, add it only if the Else_Expression has
-- a compatible type.
else
while Present (It.Nam) loop
-- For each possible intepretation of the Then Expression,
-- add it only if the else expression has a compatible type.
if Has_Compatible_Type (Else_Expr, It.Typ) then
Add_One_Interp (N, It.Typ, It.Typ);
end if;

12
gcc/ada/sem_ch5.adb
View File

@ -1100,7 +1100,7 @@ package body Sem_Ch5 is
Analyze_Choices (N, Exp_Type, Dont_Care, Others_Present);
-- A case statement with a single "others" alternative is not allowed
-- in SPARK or ALFA
-- in SPARK or ALFA.
if Formal_Verification_Mode
and then Others_Present
@ -1225,7 +1225,7 @@ package body Sem_Ch5 is
end if;
-- In formal mode, verify that the exit statement respects the SPARK
-- restrictions
-- restrictions.
if Formal_Verification_Mode then
if Present (Cond) then
@ -1233,6 +1233,7 @@ package body Sem_Ch5 is
Formal_Error_Msg_N
("exit with when clause must be directly in loop", N);
end if;
else
if Nkind (Parent (N)) /= N_If_Statement then
if Nkind (Parent (N)) = N_Elsif_Part then
@ -1240,17 +1241,18 @@ package body Sem_Ch5 is
else
Formal_Error_Msg_N ("exit must be directly in IF", N);
end if;
elsif Nkind (Parent (Parent (N))) /= N_Loop_Statement then
Formal_Error_Msg_N ("exit must be in IF directly in loop", N);
-- First test the presence of ELSE, so that an exit in an ELSE
-- leads to an error mentioning the ELSE
-- leads to an error mentioning the ELSE.
elsif Present (Else_Statements (Parent (N))) then
Formal_Error_Msg_N ("exit must be in IF without ELSE", N);
-- An exit in an ELSIF does not reach here, as it would have been
-- detected in the case (Nkind (Parent (N)) /= N_If_Statement)
-- detected in the case (Nkind (Parent (N)) /= N_If_Statement).
elsif Present (Elsif_Parts (Parent (N))) then
Formal_Error_Msg_N ("exit must be in IF without ELSIF", N);
@ -1866,7 +1868,7 @@ package body Sem_Ch5 is
end;
-- Loop parameter specification must include subtype mark in
-- SPARK or ALFA
-- SPARK or ALFA.
if Formal_Verification_Mode
and then Nkind (DS) = N_Range

28
gcc/ada/sem_ch6.adb
View File

@ -335,9 +335,10 @@ package body Sem_Ch6 is
Error_Msg_N ("illegal context for return statement", N);
end if;
if Kind = E_Function or else Kind = E_Generic_Function then
if Ekind_In (Kind, E_Function, E_Generic_Function) then
Analyze_Function_Return (N);
elsif Kind = E_Procedure or else Kind = E_Generic_Procedure then
elsif Ekind_In (Kind, E_Procedure, E_Generic_Procedure) then
Set_Return_Present (Scope_Id);
end if;
@ -685,13 +686,13 @@ package body Sem_Ch6 is
Check_Limited_Return (Expr);
-- The only RETURN allowed in SPARK or ALFA is as the last statement
-- of the function
-- of the function.
if Formal_Verification_Mode
and then Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements
and then
(Nkind (Parent (Parent (N))) /= N_Subprogram_Body
or else Present (Next (N)))
or else Present (Next (N)))
then
Formal_Error_Msg_N
("RETURN should be the last statement in function", N);
@ -1633,9 +1634,9 @@ package body Sem_Ch6 is
procedure Check_Missing_Return;
-- Checks for a function with a no return statements, and also performs
-- the warning checks implemented by Check_Returns.
-- In formal mode, also verify that a function ends with a RETURN and
-- that a procedure does not contain any RETURN.
-- the warning checks implemented by Check_Returns. In formal mode, also
-- verify that a function ends with a RETURN and that a procedure does
-- not contain any RETURN.
function Disambiguate_Spec return Entity_Id;
-- When a primitive is declared between the private view and the full
@ -1845,16 +1846,16 @@ package body Sem_Ch6 is
Id := Body_Id;
end if;
-- In formal mode, the last statement of a function should be
-- a return statement
-- In formal mode, the last statement of a function should be a
-- return statement.
if Formal_Verification_Mode then
declare
Last_Kind : constant Node_Kind :=
Nkind (Last (Statements (HSS)));
begin
if Last_Kind /= N_Simple_Return_Statement
and then Last_Kind /= N_Extended_Return_Statement
if not Nkind_In (Last_Kind, N_Simple_Return_Statement,
N_Extended_Return_Statement)
then
Formal_Error_Msg_N
("last statement in function should be RETURN", N);
@ -1886,6 +1887,9 @@ package body Sem_Ch6 is
Id := Body_Id;
end if;
-- Would be nice to point to return statement here, can we
-- borrow the Check_Returns procedure here ???
if Return_Present (Id) then
Formal_Error_Msg_N ("procedure should not have RETURN", N);
end if;
@ -6100,7 +6104,7 @@ package body Sem_Ch6 is
if Scope (E) /= Scope (S)
and then (not Is_Overloadable (E)
or else Subtype_Conformant (E, S))
or else Subtype_Conformant (E, S))
and then (Is_Immediately_Visible (E)
or else
Is_Potentially_Use_Visible (S))

14
gcc/ada/sem_ch6.ads
View File

@ -204,8 +204,8 @@ package Sem_Ch6 is
Derived_Type : Entity_Id := Empty);
-- Process new overloaded entity. Overloaded entities are created by
-- enumeration type declarations, subprogram specifications, entry
-- declarations, and (implicitly) by type derivations. Derived_Type non-
-- Empty indicates that this is a subprogram derived for that type.
-- declarations, and (implicitly) by type derivations. If Derived_Type
-- is non-empty then this is a subprogram derived for that type.
procedure Process_Formals (T : List_Id; Related_Nod : Node_Id);
-- Enter the formals in the scope of the subprogram or entry, and
@ -239,7 +239,7 @@ package Sem_Ch6 is
Old_Id : Entity_Id;
Skip_Controlling_Formals : Boolean := False) return Boolean;
-- Determine whether two callable entities (subprograms, entries, literals)
-- are subtype conformant (RM6.3.1(16)). Skip_Controlling_Formals is True
-- are subtype conformant (RM 6.3.1(16)). Skip_Controlling_Formals is True
-- when checking the conformance of a subprogram that implements an
-- interface operation. In that case, only the non-controlling formals
-- can (and must) be examined.
@ -249,10 +249,10 @@ package Sem_Ch6 is
Old_Id : Entity_Id;
Skip_Controlling_Formals : Boolean := False) return Boolean;
-- Determine whether two callable entities (subprograms, entries, literals)
-- are type conformant (RM6.3.1(14)). Skip_Controlling_Formals is True when
-- checking the conformance of a subprogram that implements an interface
-- operation. In that case, only the non-controlling formals can (and must)
-- be examined.
-- are type conformant (RM 6.3.1(14)). Skip_Controlling_Formals is True
-- when checking the conformance of a subprogram that implements an
-- interface operation. In that case, only the non-controlling formals
-- can (and must) be examined.
procedure Valid_Operator_Definition (Designator : Entity_Id);
-- Verify that an operator definition has the proper number of formals

8
gcc/ada/sem_ch8.adb
View File

@ -6282,11 +6282,15 @@ package body Sem_Ch8 is
-- active set of scopes.
for J in reverse 0 .. Scope_Stack.Last loop
-- S was reached without seing a loop scope first
if Scope_Stack.Table (J).Entity = S then
-- S was reached without seing a loop scope first
return False;
-- S was not yet reached, so it contains at least one inner loop
elsif Ekind (Scope_Stack.Table (J).Entity) = E_Loop then
-- S was not yet reached, so it contains at least one inner loop
return True;
end if;

20
gcc/ada/sem_ch8.ads
View File

@ -102,13 +102,13 @@ package Sem_Ch8 is
-- processing for 'Class attribute references.
function Has_Loop_In_Inner_Open_Scopes (S : Entity_Id) return Boolean;
-- S is the entity of an open scope. This function determines if there
-- is an inner scope of S which is a loop (i.e. it appears somewhere in
-- the scope stack after S).
-- S is the entity of an open scope. This function determines if there is
-- an inner scope of S which is a loop (i.e. it appears somewhere in the
-- scope stack after S).
function In_Open_Scopes (S : Entity_Id) return Boolean;
-- S is the entity of a scope. This function determines if this scope
-- is currently open (i.e. it appears somewhere in the scope stack).
-- S is the entity of a scope. This function determines if this scope is
-- currently open (i.e. it appears somewhere in the scope stack).
procedure Initialize;
-- Initializes data structures used for visibility analysis. Must be
@ -125,13 +125,13 @@ package Sem_Ch8 is
-- analysis of the subunit, the parent's environment is again identical.
procedure Push_Scope (S : Entity_Id);
-- Make new scope stack entry, pushing S, the entity for a scope
-- onto the top of the scope table. The current setting of the scope
-- suppress flags is saved for restoration on exit.
-- Make new scope stack entry, pushing S, the entity for a scope onto the
-- top of the scope table. The current setting of the scope suppress flags
-- is saved for restoration on exit.
procedure Pop_Scope;
-- Remove top entry from scope stack, restoring the saved setting
-- of the scope suppress flags.
-- Remove top entry from scope stack, restoring the saved setting of the
-- scope suppress flags.
function Present_System_Aux (N : Node_Id := Empty) return Boolean;
-- Return True if the auxiliary system file has been successfully loaded.

30
gcc/ada/sem_util.adb
View File

@ -3200,32 +3200,30 @@ package body Sem_Util is
Append_Entity (Def_Id, S);
Set_Public_Status (Def_Id);
-- Declaring an homonym is not allowed in SPARK or ALFA...
-- Declaring a homonym is not allowed in SPARK or ALFA ...
if Formal_Verification_Mode and then Present (C)
-- ...unless the new declaration is in a subprogram, and the visible
-- ... unless the new declaration is in a subprogram, and the visible
-- declaration is a variable declaration or a parameter specification
-- outside that subprogram;
-- outside that subprogram.
and then not
(Nkind_In (Parent (Parent (Def_Id)),
N_Subprogram_Body,
N_Function_Specification,
N_Procedure_Specification)
(Nkind_In (Parent (Parent (Def_Id)), N_Subprogram_Body,
N_Function_Specification,
N_Procedure_Specification)
and then
Nkind_In (Parent (C),
N_Object_Declaration,
N_Parameter_Specification))
Nkind_In (Parent (C), N_Object_Declaration,
N_Parameter_Specification))
-- ...or the new declaration is in a package, and the visible
-- declaration occurs outside that package;
-- ... or the new declaration is in a package, and the visible
-- declaration occurs outside that package.
and then not Nkind_In (Parent (Parent (Def_Id)),
N_Package_Specification,
N_Package_Body)
and then not
Nkind_In (Parent (Parent (Def_Id)), N_Package_Specification,
N_Package_Body)
-- ...or the new declaration is a component declaration in a record
-- ... or the new declaration is a component declaration in a record
-- type definition.
and then Nkind (Parent (Def_Id)) /= N_Component_Declaration