+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
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;
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
-- 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
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;
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;
-- 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.
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);
-- 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;
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;
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;
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,
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 :=
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
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.
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
-- 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
begin
Set_Etype (N, Any_Type);
+
+ -- Shouldn't the following statement be down in the ELSE of the
+ -- following loop? ???
+
Get_First_Interp (Then_Expr, I, It);
- if No (Else_Expr) then
- -- if no else_expression the conditional must be boolean.
+ -- if no Else_Expression the conditional must be boolean
+
+ if No (Else_Expr) then
Set_Etype (N, Standard_Boolean);
- 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.
+ -- 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
if Has_Compatible_Type (Else_Expr, It.Typ) then
Add_One_Interp (N, It.Typ, It.Typ);
end if;
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
end if;
-- In formal mode, verify that the exit statement respects the SPARK
- -- restrictions
+ -- restrictions.
if Formal_Verification_Mode then
if Present (Cond) then
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
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);
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
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;
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);
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
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);
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;
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))
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
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.
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
-- 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;
-- 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
-- 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.
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
projects / gcc.git / commitdiff