+2018-12-11 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_aggr.adb, exp_ch7.adb, gnat1drv.adb, sem_ch10.adb,
+ sem_ch13.adb, sem_ch6.adb, sem_ch7.adb, sem_util.adb: Minor
+ reformatting.
+
2018-12-11 Eric Botcazou <ebotcazou@adacore.com>
* fe.h (Is_Atomic_Object): Declare.
is
In_Obj_Decl : Boolean := False;
P : Node_Id := Parent (N);
+
begin
while Present (P) loop
if Nkind (P) = N_Object_Declaration then
----------------------------
function Static_Array_Aggregate (N : Node_Id) return Boolean is
-
- function Is_Static_Component (N : Node_Id) return Boolean;
- -- Return True if N has a compile-time known value and can be passed as
- -- is to the back-end without further expansion.
+ function Is_Static_Component (Nod : Node_Id) return Boolean;
+ -- Return True if Nod has a compile-time known value and can be passed
+ -- as is to the back-end without further expansion.
---------------------------
-- Is_Static_Component --
---------------------------
- function Is_Static_Component (N : Node_Id) return Boolean is
+ function Is_Static_Component (Nod : Node_Id) return Boolean is
begin
- if Nkind_In (N, N_Integer_Literal, N_Real_Literal) then
+ if Nkind_In (Nod, N_Integer_Literal, N_Real_Literal) then
return True;
- elsif Is_Entity_Name (N)
- and then Present (Entity (N))
- and then Ekind (Entity (N)) = E_Enumeration_Literal
+ elsif Is_Entity_Name (Nod)
+ and then Present (Entity (Nod))
+ and then Ekind (Entity (Nod)) = E_Enumeration_Literal
then
return True;
- elsif Nkind (N) = N_Aggregate
- and then Compile_Time_Known_Aggregate (N)
+ elsif Nkind (Nod) = N_Aggregate
+ and then Compile_Time_Known_Aggregate (Nod)
then
return True;
end if;
end Is_Static_Component;
- Bounds : constant Node_Id := Aggregate_Bounds (N);
+ -- Local variables
+
+ Bounds : constant Node_Id := Aggregate_Bounds (N);
+ Typ : constant Entity_Id := Etype (N);
- Typ : constant Entity_Id := Etype (N);
- Agg : Node_Id;
- Expr : Node_Id;
- Lo : Node_Id;
- Hi : Node_Id;
+ Agg : Node_Id;
+ Expr : Node_Id;
+ Lo : Node_Id;
+ Hi : Node_Id;
-- Start of processing for Static_Array_Aggregate
-- may need an activation record.
function First_Local_Scope (L : List_Id) return Entity_Id;
- -- Find first entity in the elaboration code of the body that
- -- contains or represents a subprogrsam body. A body can appear
- -- within a block or a loop. or can appear by itself if generated
- -- for an object declaration that involves controlled actions.
- -- The first such entity encountered is used to reset the scopes
- -- of all entities that become local to the hew elboration procedure.
- -- This is needed for subsequent unnesting, which depends on the
- -- scope links to determine the nesting level of each subprogram.
+ -- Find first entity in the elaboration code of the body that contains
+ -- or represents a subprogram body. A body can appear within a block or
+ -- a loop or can appear by itself if generated for an object declaration
+ -- that involves controlled actions. The first such entity encountered
+ -- is used to reset the scopes of all entities that become local to the
+ -- new elaboration procedure. This is needed for subsequent unnesting,
+ -- which depends on the scope links to determine the nesting level of
+ -- each subprogram.
--------------------------
-- Contains_Subprogram --
begin
E := First_Entity (Blk);
-
while Present (E) loop
if Is_Subprogram (E) then
return True;
case Nkind (Stat) is
when N_Block_Statement =>
Id := Entity (Identifier (Stat));
+
if No (First_Ent) then
First_Ent := Id;
end if;
when N_Loop_Statement =>
Id := Entity (Identifier (Stat));
+
if No (First_Ent) then
First_Ent := Id;
end if;
declare
Elif : Node_Id;
+
begin
Elif := First (Elsif_Parts (Stat));
-
while Present (Elif) loop
Scop := First_Local_Scope (Statements (Elif));
when N_Case_Statement =>
declare
Alt : Node_Id;
+
begin
Alt := First (Alternatives (Stat));
-
while Present (Alt) loop
Scop := First_Local_Scope (Statements (Alt));
when N_Subprogram_Body =>
Id := Defining_Entity (Stat);
+
if No (First_Ent) then
First_Ent := Id;
end if;
and then Present (H_Seq)
and then Is_Compilation_Unit (Current_Scope)
then
- Ent :=
- First_Local_Scope (Statements (H_Seq));
+ Ent := First_Local_Scope (Statements (H_Seq));
-- There msy be subprograms declared in the exception handlers
-- of the current body.
-- error message but do not print the internal 'usage' message.
if GNATprove_Mode then
- Write_Str ("one of the following is not a valid switch"
- & " or source file name: ");
+ Write_Str
+ ("one of the following is not a valid switch or source file "
+ & "name: ");
Osint.Dump_Command_Line_Source_File_Names;
else
Usage;
Remove_Scope;
end if;
- if Nkind_In
- (Unit (Lib_Spec), N_Package_Body, N_Subprogram_Body)
+ if Nkind_In (Unit (Lib_Spec), N_Package_Body,
+ N_Subprogram_Body)
then
Remove_Context (Library_Unit (Lib_Spec));
end if;
Assoc := First (Component_Associations (Expr));
while Present (Assoc) loop
Analyze (Expression (Assoc));
+
if not Is_Entity_Name (Expression (Assoc)) then
Error_Msg_N ("value must be a function", Assoc);
end if;
-- The following aspect expressions may contain references to
-- components and discriminants of the type.
- elsif A_Id = Aspect_Dynamic_Predicate
+ elsif A_Id = Aspect_Dynamic_Predicate
or else A_Id = Aspect_Predicate
or else A_Id = Aspect_Priority
then
Preanalyze_Spec_Expression (End_Decl_Expr, T);
end if;
- Err := not Fully_Conformant_Expressions
+ Err :=
+ not Fully_Conformant_Expressions
(End_Decl_Expr, Freeze_Expr, Report => True);
end if;
and then Scope (E) = Current_Scope
then
declare
+ A_Id : Aspect_Id;
Ritem : Node_Id;
- A_Id : Aspect_Id;
begin
-- Look for aspect specification entries for this entity
and then Is_Delayed_Aspect (Ritem)
then
A_Id := Get_Aspect_Id (Ritem);
+
if A_Id = Aspect_Dynamic_Predicate
or else A_Id = Aspect_Predicate
or else A_Id = Aspect_Priority
end if;
- -- For a record type, deal with variant parts. This has to be delayed
- -- to this point, because of the issue of statically predicated
- -- subtypes, which we have to ensure are frozen before checking
- -- choices, since we need to have the static choice list set.
+ -- For a record type, deal with variant parts. This has to be delayed to
+ -- this point, because of the issue of statically predicated subtypes,
+ -- which we have to ensure are frozen before checking choices, since we
+ -- need to have the static choice list set.
if Is_Record_Type (E) then
Check_Variant_Part : declare
end if;
end New_Stream_Subprogram;
+ --------------
+ -- Pop_Type --
+ --------------
+
+ procedure Pop_Type (E : Entity_Id) is
+ begin
+ if Ekind (E) = E_Record_Type and then E = Current_Scope then
+ End_Scope;
+
+ elsif Is_Type (E)
+ and then Has_Discriminants (E)
+ and then Nkind (Parent (E)) /= N_Subtype_Declaration
+ then
+ Uninstall_Discriminants (E);
+ Pop_Scope;
+ end if;
+ end Pop_Type;
+
---------------
-- Push_Type --
---------------
procedure Push_Type (E : Entity_Id) is
Comp : Entity_Id;
+
begin
if Ekind (E) = E_Record_Type then
Push_Scope (E);
+
Comp := First_Component (E);
while Present (Comp) loop
Install_Entity (Comp);
end if;
elsif Is_Type (E)
- and then Has_Discriminants (E)
- and then Nkind (Parent (E)) /= N_Subtype_Declaration
+ and then Has_Discriminants (E)
+ and then Nkind (Parent (E)) /= N_Subtype_Declaration
then
Push_Scope (E);
Install_Discriminants (E);
N : Node_Id;
FOnly : Boolean := False) return Boolean
is
- S : Entity_Id;
- Parent_Type : Entity_Id;
-
function Is_Derived_Type_With_Constraint return Boolean;
-- Check whether T is a derived type with an explicit constraint, in
-- which case the constraint has frozen the type and the item is too
function Is_Derived_Type_With_Constraint return Boolean is
Decl : constant Node_Id := Declaration_Node (T);
+
begin
return Is_Derived_Type (T)
and then Is_Frozen (Base_Type (T))
end if;
end Too_Late;
+ -- Local variables
+
+ Parent_Type : Entity_Id;
+ S : Entity_Id;
+
-- Start of processing for Rep_Item_Too_Late
begin
-- First make sure entity is not frozen (RM 13.1(9))
if (Is_Frozen (T)
- or else (Is_Type (T)
- and then Is_Derived_Type_With_Constraint))
+ or else (Is_Type (T)
+ and then Is_Derived_Type_With_Constraint))
-- Exclude imported types, which may be frozen if they appear in a
-- representation clause for a local type.
end if;
end Uninstall_Discriminants;
- --------------
- -- Pop_Type --
- --------------
-
- procedure Pop_Type (E : Entity_Id) is
- begin
- if Ekind (E) = E_Record_Type and then E = Current_Scope then
- End_Scope;
- return;
-
- elsif Is_Type (E)
- and then Has_Discriminants (E)
- and then Nkind (Parent (E)) /= N_Subtype_Declaration
- then
- Uninstall_Discriminants (E);
- Pop_Scope;
- end if;
- end Pop_Type;
-
------------------------------
-- Validate_Address_Clauses --
------------------------------
-- for analysis and/or expansion to make things look as though they
-- conform when they do not, e.g. by converting 1+2 into 3.
- Result : Boolean;
- function FCE (Given_E1, Given_E2 : Node_Id) return Boolean;
- function FCE (Given_E1, Given_E2 : Node_Id) return Boolean is
- begin
- return Fully_Conformant_Expressions (Given_E1, Given_E2, Report);
- end FCE;
+ function FCE (Given_E1 : Node_Id; Given_E2 : Node_Id) return Boolean;
+ -- ???
- function FCL (L1, L2 : List_Id) return Boolean;
+ function FCL (L1 : List_Id; L2 : List_Id) return Boolean;
-- Compare elements of two lists for conformance. Elements have to be
-- conformant, and actuals inserted as default parameters do not match
-- explicit actuals with the same value.
- function FCO (Op_Node, Call_Node : Node_Id) return Boolean;
+ function FCO (Op_Node : Node_Id; Call_Node : Node_Id) return Boolean;
-- Compare an operator node with a function call
+ ---------
+ -- FCE --
+ ---------
+
+ function FCE (Given_E1 : Node_Id; Given_E2 : Node_Id) return Boolean is
+ begin
+ return Fully_Conformant_Expressions (Given_E1, Given_E2, Report);
+ end FCE;
+
---------
-- FCL --
---------
- function FCL (L1, L2 : List_Id) return Boolean is
- N1, N2 : Node_Id;
+ function FCL (L1 : List_Id; L2 : List_Id) return Boolean is
+ N1 : Node_Id;
+ N2 : Node_Id;
begin
if L1 = No_List then
-- FCO --
---------
- function FCO (Op_Node, Call_Node : Node_Id) return Boolean is
+ function FCO (Op_Node : Node_Id; Call_Node : Node_Id) return Boolean is
Actuals : constant List_Id := Parameter_Associations (Call_Node);
Act : Node_Id;
end if;
end FCO;
+ -- Local variables
+
+ Result : Boolean;
+
-- Start of processing for Fully_Conformant_Expressions
begin
-- to the same freeze node as their corresponding full view, if any.
-- But we ought not to overwrite a node already inserted in the tree.
- pragma Assert (Serious_Errors_Detected /= 0
- or else No (Freeze_Node (Priv))
- or else No (Parent (Freeze_Node (Priv)))
- or else Freeze_Node (Priv) = Freeze_Node (Full));
+ pragma Assert
+ (Serious_Errors_Detected /= 0
+ or else No (Freeze_Node (Priv))
+ or else No (Parent (Freeze_Node (Priv)))
+ or else Freeze_Node (Priv) = Freeze_Node (Full));
Set_Freeze_Node (Priv, Freeze_Node (Full));
Deref := Expression (Deref);
end if;
- -- Ada 2005: If we have a component or slice of a dereference,
- -- something like X.all.Y (2), and the type of X is access-to-constant,
- -- Is_Variable will return False, because it is indeed a constant
- -- view. But it might be a view of a variable object, so we want the
- -- following condition to be True in that case.
+ -- Ada 2005: If we have a component or slice of a dereference, something
+ -- like X.all.Y (2) and the type of X is access-to-constant, Is_Variable
+ -- will return False, because it is indeed a constant view. But it might
+ -- be a view of a variable object, so we want the following condition to
+ -- be True in that case.
if Is_Variable (Object)
or else Is_Variable (Deref)
-- False (it could be a function selector in a prefix form call
-- occurring in an iterator specification).
- if not
- Ekind_In
- (Entity (Selector_Name (Object)), E_Component, E_Discriminant)
+ if not Ekind_In (Entity (Selector_Name (Object)), E_Component,
+ E_Discriminant)
then
return False;
end if;
P := Original_Node (Prefix (Object));
Prefix_Type := Etype (P);
- -- If the prefix is a qualified expression, we want to look at
- -- its operand.
+ -- If the prefix is a qualified expression, we want to look at its
+ -- operand.
if Nkind (P) = N_Qualified_Expression then
P := Expression (P);
projects / thirdparty / gcc.git / commitdiff
